# -*- Tcl -*-
package prefer latest
package require nx

set ::tcl86 [package vsatisfies [package req Tcl] 8.6]

#
# Intentionally, we do not want to make a "namespace import" in this
# test file. Run this file via a pure tclsh!
#
namespace path nx

# Don't use test, since both, package test and contains redefine "new",
# so we have a conflict....

proc ? {cmd expected {msg ""}} {
   #puts "??? $cmd"                 
   set r [uplevel $cmd]
   if {$msg eq ""} {set msg $cmd}
   if {$r ne $expected} {
     puts stderr "ERROR $msg returned '$r' ne '$expected'"
     error "FAILED $msg returned '$r' ne '$expected'"
   } else {
     puts stderr "OK $msg"
   }
}

#
# We define here a few attributes of type method, such we can add
# arbitrary "-" calls
#
Class create Tree {
  :property label
  :property contains:alias
  :property foo:alias
  :public method foo {arg} {set :x $arg}
}
set y [Tree new -foo hu]
? [list $y eval {set :x}] hu

#
# actually, the intention was to define an xotcl-like -contains
#
set x [Tree create 1 -label 1 -contains {
  ? {self} ::1
  ? {namespace current} ::1
  Tree create 1.1 -label 1.1
  Tree create 1.2 -label 1.2 -contains {
    ? {self} ::1::1.2
    ? {namespace current} ::1::1.2
    Tree create 1.2.1 -label 1.2.1
    Tree create 1.2.2 -label 1.2.2 -contains {
      Tree create 1.2.2.1 -label 1.2.2.1
      ? {self} ::1::1.2::1.2.2
    }
    Tree create 1.2.3 -label 1.2.3
  }
  Tree create 1.3 -label 1.3
}]

set x [Tree create t -contains {
  ? {Tree create branch} ::t::branch
  ? {Tree new} ::t::__#1
}]

#
# error and errorcode propagation from within contains
#

Class create Arbre
? {catch {Arbre create root {
  :contains {
    Arbre create level1 {
      :contains {
        Arbre level2
      }
    }
  }
}} msg opts; set msg} "method 'level2' unknown for ::Arbre; in order to create an instance of class ::Arbre, consider using '::Arbre create level2 ?...?'"

Class create Arbre
? {catch {Arbre create root {
  :contains {
    Arbre create level1 {
      :contains {
        return -code error -errorcode MYERR
      }
    }
  }
}} msg opts; dict get $opts -errorcode} "MYERR"

#
# Test resolving next without namespace import/path
#
namespace path ""
# make sure, we have no "::next" defined or globally imported
? {info command ::next} ""

nx::Class create C {
  :public method foo {} {next; return 12}
  :create c1
}
? {c1 foo} 12
? {c1 foo} 12

C create c2 {
  set :s [self]
  set :c [current]
  :public object method bar {} {return "[set :s]-[set :c]"}
}
? {c2 bar} "::c2-::c2"

# 
# Test potential crash, when methodNamePath is computed without a
# stack frame
#
C public method foo {{-new 0} name value} { return $value}
catch {c1 foo -name a b} errMsg
? {set errMsg} \
    {invalid argument 'b', maybe too many arguments; should be "::c1 foo ?-new /value/? /name/ /value/"}

# Test resolving of implicit namespaces in relationcmds (here
# superclass) in the nx namespace.
namespace path ""

namespace eval ::nx {

  #puts stderr =====1
  set c [Class create C -superclass Class {
    :object method foo {} {;}
  }]
  ? {set c} ::C

  # recreate
  set c [Class create C -superclass Class ]
  ? {set c} ::C
  #puts stderr =====3
}

#
# Forget and reload nx
#

#puts ====NX-[package versions nx]-[set auto_path]
package forget nx
package req nx

#puts ====XOTCL-[package versions XOTcl]-[set auto_path]
package require XOTcl 2.0
package forget XOTcl
package require XOTcl 2.0


########################################################################
#
# Test that we do not allow one to mix object systems within the intrinsic
# classes of an object. Otherwise we would have problems with the
# recreate "C0 create c0". On a recreate of c0 the object system for
# C0 is ::xotcl, therefore we try to call recreate. In the C0 class
# hierarchy is from nx and contains no "recreate" method.

? {catch {::xotcl::Class create C0 -superclass ::nx::Object} errorMsg} 1
? {set ::errorMsg} {class "::C0" has a different object system as class  "::nx::Object"}
::nx::Class create C1 -superclass ::nx::Object

# trigger the call of "cleanup" to work via method dispatch
::xotcl::Object create o1
o1 proc cleanup {} {puts stderr "CLEANUP"; return}

#C0 create c0
#C0 create c0
C1 create c1
C1 create c1

c1 destroy
C1 destroy


? {nx::Object create o} ::o
? {o contains { nx::Object create p}} ::o::p
? {catch {o contains { return -code error -errorcode {FOO bar baz} somethingwrong}} errorMsg} 1
set ::errorinfo $::errorInfo
set ::errorcode $::errorCode
? {set ::errorMsg} {somethingwrong}

if {$::tcl86} {
  set r {somethingwrong
    while executing
"o contains { return -code error -errorcode {FOO bar baz} somethingwrong}"} 
} else {
  set r {somethingwrong
    ::o ::nx::Object->contains
    invoked from within
"o contains { return -code error -errorcode {FOO bar baz} somethingwrong}"}
}
? {set ::errorinfo} $r
? {set ::errorcode} {FOO bar baz}

puts stderr "====EXIT [info script]"
#
# Local variables:
#    mode: tcl
#    tcl-indent-level: 2
#    indent-tabs-mode: nil
# End: