# -*- Tcl -*- package prefer latest package require nx # # 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 }] # # 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 method bar {} {return "[set :s]-[set :c]"} } ? {c2 bar} "::c2-::c2" # 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 { :class method foo {} {;} }] ? {set c} ::C # recreate set c [Class create C -superclass Class ] ? {set c} ::C #puts stderr =====3 } puts ====NX 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 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 #puts stderr ===EXIT