Index: library/lib/nx-test.tcl
===================================================================
diff -u -r5ab2ad98d7e3d8509a26ea32ec64fa9cc78af2f8 -r1d2bdbea2141f159f982e8dde0f9b0a6778a8b71
--- library/lib/nx-test.tcl (.../nx-test.tcl) (revision 5ab2ad98d7e3d8509a26ea32ec64fa9cc78af2f8)
+++ library/lib/nx-test.tcl (.../nx-test.tcl) (revision 1d2bdbea2141f159f982e8dde0f9b0a6778a8b71)
@@ -1,6 +1,10 @@
package provide nx::test 1.0
package require nx
+if {![llength [info commands try]]} {
+ package req try
+}
+
namespace eval ::nx {
# @file Simple regression test support for XOTcl / NX
Index: tests/contains.test
===================================================================
diff -u -ra2c877c7dd15b66e27dd85c9c17744670474d132 -r1d2bdbea2141f159f982e8dde0f9b0a6778a8b71
--- tests/contains.test (.../contains.test) (revision a2c877c7dd15b66e27dd85c9c17744670474d132)
+++ tests/contains.test (.../contains.test) (revision 1d2bdbea2141f159f982e8dde0f9b0a6778a8b71)
@@ -182,7 +182,8 @@
set ::errorcode $::errorCode
? {set ::errorMsg} {somethingwrong}
? {set ::errorinfo} {somethingwrong
- while executing
+ ::o ::nx::Object->contains
+ invoked from within
"o contains { return -code error -errorcode {FOO bar baz} somethingwrong}"}
? {set ::errorcode} {FOO bar baz}
Index: tests/destroy.test
===================================================================
diff -u -r5ab2ad98d7e3d8509a26ea32ec64fa9cc78af2f8 -r1d2bdbea2141f159f982e8dde0f9b0a6778a8b71
--- tests/destroy.test (.../destroy.test) (revision 5ab2ad98d7e3d8509a26ea32ec64fa9cc78af2f8)
+++ tests/destroy.test (.../destroy.test) (revision 1d2bdbea2141f159f982e8dde0f9b0a6778a8b71)
@@ -2,6 +2,8 @@
package require nx
package require nx::test
+set ::tcl86 [package vsatisfies [package req Tcl] 8.6]
+
nx::test configure -count 10
::nx::configure defaultMethodCallProtection false
@@ -161,7 +163,12 @@
puts stderr "AAAA [current] exists [::nsf::object::exists [current]]"
:set x 1
#? "[current] set x" 1 "$::case can still access [current]"
- ? "[current] set x" {TCL LOOKUP VARNAME x} "$::case cannot access [current]"
+
+ if {$::tcl86} {
+ ? "[current] set x" {TCL LOOKUP VARNAME x} "$::case cannot access [current]"
+ } else {
+ ? "[current] set x" {can't read "x": no such variable} "$::case cannot access [current]"
+ }
? {::nsf::object::exists c1} 1 "$::case object still exists in proc"
#? "set ::firstDestroy" 0 "firstDestroy called"
#? "set ::ObjectDestroy" 0 "ObjectDestroy called"
Fisheye: Tag 1d2bdbea2141f159f982e8dde0f9b0a6778a8b71 refers to a dead (removed) revision in file `tests/double-alias.tcl'.
Fisheye: No comparison available. Pass `N' to diff?
Index: tests/double-alias.test
===================================================================
diff -u
--- tests/double-alias.test (revision 0)
+++ tests/double-alias.test (revision 1d2bdbea2141f159f982e8dde0f9b0a6778a8b71)
@@ -0,0 +1,173 @@
+package prefer latest
+package require nx::test
+
+
+nx::test case alias-redefine-method1 {
+ #
+ # redefine an object method by an alias pointing to an alias
+ #
+ proc ::foo args {;}
+
+ nx::Object create o
+ ? {::o public object method BAR {} {;}} ::o::BAR
+ ? {::nsf::method::alias ::o bar ::foo} ::o::bar
+
+ ? {info commands ::o::bar} ::o::bar "::o::bar exists"
+ ? {info commands ::o::BAR} ::o::BAR "a command ::o::BAR exists"
+ ? {::nsf::method::alias o BAR ::o::bar} ::o::BAR "redefine an object method with an alias (pointing to an alias) 87a2"
+}
+
+nx::test case alias-redefine-method2 {
+ #
+ # redefine an object method by an alias pointing to an object method
+ #
+ proc ::foo args {;}
+
+ nx::Object create o
+ ? {::o public object method BAR {} {;}} ::o::BAR
+ ? {::o public object method FOO {} {;}} ::o::FOO
+
+ ? {info commands ::o::FOO} ::o::FOO "a command ::o::FOO exists"
+ ? {info commands ::o::BAR} ::o::BAR "a command ::o::BAR exists"
+ ? {::nsf::method::alias o BAR ::o::FOO} ::o::BAR "redefine an object method with an alias (pointing to a method) 87a2"
+}
+
+
+nx::test case alias-double-alias-proc {
+
+ proc ::foo args {;}
+ nx::Object create o
+
+ ? {info commands ::o::FOO} "" "a command ::o::FOO' does not exist"
+ ? {info commands ::o::BAR} "" "a command ::o::BAR does not exist"
+ ? {::nsf::method::alias o FOO ::foo} ::o::FOO "define an object alias based on existing ::foo"
+ ? {::nsf::method::alias o BAR ::o::FOO} ::o::BAR "define an object alias based on alias based on existing ::o::FOO"
+}
+
+nx::test case alias-double-alias-define {
+ #
+ # same as alias-double-reference-proc, but method instead of proc as target of o::FOO
+ #
+ proc ::foo args {;}
+
+ nx::Object create o
+ ? {::nsf::method::alias ::o bar ::foo} ::o::bar
+
+ ? {info commands ::o::bar} ::o::bar "::o::bar exists"
+ ? {info commands ::o::FOO} "" "a command ::o::FOO' does not exists"
+ ? {info commands ::o::BAR} "" "a command ::o::BAR does not exist"
+ ? {::nsf::method::alias o FOO ::o::bar} ::o::FOO "define an object alias based on existing ::o::bar"
+ ? {::nsf::method::alias o BAR ::o::FOO} ::o::BAR "define an object alias based on alias based on existing (?) ::o::bar"
+}
+
+
+nx::test case alias-double-alias-redefine {
+ #
+ # same as alias-double-reference-define, but redefined instead of new definition
+ #
+ proc ::foo args {;}
+
+ nx::Object create o
+ ? {::nsf::method::alias ::o FOO ::foo} ::o::FOO
+ ? {::nsf::method::alias ::o bar ::foo} ::o::bar
+
+ ? {info commands ::o::bar} ::o::bar "::o::bar exists"
+ ? {info commands ::o::FOO} ::o::FOO "a command ::o::FOO' exists"
+ ? {info commands ::o::BAR} "" "a command ::o::BAR does not exist"
+ ? {::nsf::method::alias o FOO ::o::bar} ::o::FOO "redefine an object alias based on existing ::o::bar"
+ ? {::nsf::method::alias o BAR ::o::FOO} ::o::BAR "define an object alias based on alias based on existing ::o::FOO"
+}
+
+nx::test case alias-double-alias-redefine0 {
+ #
+ # same as alias-double-reference-define, but redefined second cmd instead of new definition
+ #
+ proc ::foo args {;}
+
+ nx::Object create o
+ ? {::o public object method BAR {} {;}} ::o::BAR
+ ? {::nsf::method::alias ::o bar ::foo} ::o::bar
+
+ ? {info commands ::o::bar} ::o::bar "::o::bar exists"
+ ? {info commands ::o::FOO} "" "a command ::o::FOO' does not exist"
+ ? {info commands ::o::BAR} ::o::BAR "a command ::o::BAR exists"
+ ? {::nsf::method::alias o FOO ::foo} ::o::FOO "define an object alias based on existing ::foo"
+ ? {::nsf::method::alias o BAR ::o::FOO} ::o::BAR "redefine an object alias based on alias based on existing ::o::FOO 87a2"
+}
+
+nx::test case alias-double-alias-redefine1 {
+ #
+ # same as alias-double-reference-define, but redefined second cmd instead of new definition
+ #
+ proc ::foo args {;}
+
+ nx::Object create o
+ ? {::o public object method BAR {} {;}} ::o::BAR
+ ? {::nsf::method::alias ::o bar ::foo} ::o::bar
+
+ ? {info commands ::o::bar} ::o::bar "::o::bar exists"
+ ? {info commands ::o::FOO} "" "a command ::o::FOO' does not exist"
+ ? {info commands ::o::BAR} ::o::BAR "a command ::o::BAR exists"
+ ? {::nsf::method::alias o FOO ::o::bar} ::o::FOO "define an object alias based on existing ::o::bar"
+ ? {::nsf::method::alias o BAR ::o::FOO} ::o::BAR "redefine an object alias based on alias based on existing ::o::FOO 87a2"
+}
+
+nx::test case alias-double-alias-redefine2 {
+ #
+ # same as alias-double-reference-define, but redefined twice instead of new definition
+ #
+ proc ::foo args {;}
+
+ nx::Object create o
+ ? {::nsf::method::alias ::o FOO ::foo} ::o::FOO
+ ? {::o public object method BAR {} {;}} ::o::BAR
+ ? {::nsf::method::alias ::o bar ::foo} ::o::bar
+
+ ? {info commands ::o::bar} ::o::bar "::o::bar exists"
+ ? {info commands ::o::FOO} ::o::FOO "a command ::o::FOO' exists"
+ ? {info commands ::o::BAR} ::o::BAR "a command ::o::BAR exists"
+ ? {::nsf::method::alias o FOO ::o::bar} ::o::FOO "redefine an object alias based on existing ::o::bar"
+ ? {::nsf::method::alias o BAR ::o::FOO} ::o::BAR "redefine an object alias based on alias based on existing ::o::FOO 87a2"
+}
+
+
+
+nx::test case alias-double-alias-object-method-redefine {
+
+ proc ::foo args {;}
+
+ nx::Object create o
+ ? {::nsf::method::alias ::o FOO ::foo} ::o::FOO
+ ? {::o public object method bar {} {;}} ::o::bar
+
+ ? {info commands ::o::bar} ::o::bar "handle ::o::bar exists"
+ ? {info commands ::o::FOO} ::o::FOO "a command ::o::FOO' exists"
+ ? {info commands ::o::BAR} "" "a command ::o::BAR does not exist"
+ ? {::nsf::method::alias o FOO ::o::bar} ::o::FOO "redefine an object alias based on existing (?) ::o::bar"
+ ? {::nsf::method::alias o BAR ::o::FOO} ::o::BAR "define an object alias based on alias based on existing ::o::FOO"
+ ? {info exists ::nsf::alias(::o,FOO,1)} 1
+ ? {info exists ::nsf::alias(::o,BAR,1)} 1
+
+ o public object method bar {} {}
+ ? {info exists ::nsf::alias(::o,FOO,1)} 1
+ ? {info exists ::nsf::alias(::o,BAR,1)} 1
+}
+
+
+nx::test case alias-double-alias-object-method-redefine2 {
+
+ proc ::foo args {;}
+
+ nx::Object create o
+ ? {::nsf::method::alias ::o FOO ::foo} ::o::FOO
+ ? {::o public object method BAR {} {;}} ::o::BAR
+ ? {::o public object method bar {} {;}} ::o::bar
+
+ ? {info commands ::o::bar} ::o::bar "handle ::o::bar exists"
+ ? {info commands ::o::FOO} ::o::FOO "a command ::o::FOO' exists"
+ ? {info commands ::o::BAR} ::o::BAR "a command ::o::BAR does not exist"
+ ? {::nsf::method::alias o FOO ::o::bar} ::o::FOO "redefine an object alias based on existing (?) ::o::bar"
+ ? {::nsf::method::alias o BAR ::o::FOO} ::o::BAR "redefine an object alias based on alias based on existing ::o::FOO 87a2"
+}
+
+
Index: tests/forward.test
===================================================================
diff -u -r5ab2ad98d7e3d8509a26ea32ec64fa9cc78af2f8 -r1d2bdbea2141f159f982e8dde0f9b0a6778a8b71
--- tests/forward.test (.../forward.test) (revision 5ab2ad98d7e3d8509a26ea32ec64fa9cc78af2f8)
+++ tests/forward.test (.../forward.test) (revision 1d2bdbea2141f159f982e8dde0f9b0a6778a8b71)
@@ -2,6 +2,8 @@
package require nx
package require nx::test
+set ::tcl86 [package vsatisfies [package req Tcl] 8.6]
+
###########################################
# trivial object delegation
###########################################
@@ -271,7 +273,11 @@
? {obj info object methods foo} ""
obj public object forward ::ns1::foo
? {obj info object methods foo} "foo"
- ? {obj foo X} {TCL LOOKUP COMMAND ::ns1::foo} "invalid target command"
+ if {$::tcl86} {
+ ? {obj foo X} {TCL LOOKUP COMMAND ::ns1::foo} "invalid target command"
+ } else {
+ ? {obj foo X} {invalid command name "::ns1::foo"} "invalid target command"
+ }
namespace eval ::ns1 {proc foo {p} {return $p}}
? {obj foo X} "X"
obj public object forward ::ns1::foo %method %method
@@ -354,7 +360,11 @@
? {obj foo 1 2 3} [list 1 2 3 %]
obj public object forward foo list {%obj foo}
- ? {obj foo 1 2 3} "TCL LIMIT STACK" "stack overflow"
+ if {$::tcl86} {
+ ? {obj foo 1 2 3} "TCL LIMIT STACK" "stack overflow"
+ } else {
+ ? {obj foo 1 2 3} {too many nested evaluations (infinite loop?)} "stack overflow"
+ }
obj public object forward foo list {%apply {{x} {return $x}} A}
? {obj foo 1 2 3} [list A 1 2 3]
@@ -376,7 +386,11 @@
##
obj public object forward foo list {%@end %::proc}
- ? {obj foo 1 2 3} {TCL WRONGARGS} "provided wrong arguments for target command"
+ if {$::tcl86} {
+ ? {obj foo 1 2 3} {TCL WRONGARGS} "provided wrong arguments for target command"
+ } else {
+ ? {obj foo 1 2 3} {wrong # args: should be "::proc name args body"} "provided wrong arguments for target command"
+ }
# the next test does not work unless called from nxsh, which imports ::nx::self
# obj public object forward foo list {%@end %::self}
@@ -386,14 +400,22 @@
? {obj foo 1 2 3} [list 1 2 3 ::obj] "fully qualified self"
obj public object forward foo list {%@end %::1}
- ? {obj foo 1 2 3} {TCL LOOKUP COMMAND ::1} "forward to non-existing object"
+ if {$::tcl86} {
+ ? {obj foo 1 2 3} {TCL LOOKUP COMMAND ::1} "forward to non-existing object"
+ } else {
+ ? {obj foo 1 2 3} {invalid command name "::1"} "forward to non-existing object"
+ }
##
## position prefixes are interpreted in a context-dependent manner:
##
obj public object forward foo list {%@1 %@1}
- ? {obj foo 1 2 3} {TCL LOOKUP COMMAND @1} "forward to non-existing cmd"
+ if {$::tcl86} {
+ ? {obj foo 1 2 3} {TCL LOOKUP COMMAND @1} "forward to non-existing cmd"
+ } else {
+ ? {obj foo 1 2 3} {invalid command name "@1"} "forward to non-existing cmd"
+ }
if {![string length "ISSUES"]} {
Index: tests/info-variable.test
===================================================================
diff -u -r2f921800dfd3c92bfa176f9d00f366bfc9341da1 -r1d2bdbea2141f159f982e8dde0f9b0a6778a8b71
--- tests/info-variable.test (.../info-variable.test) (revision 2f921800dfd3c92bfa176f9d00f366bfc9341da1)
+++ tests/info-variable.test (.../info-variable.test) (revision 1d2bdbea2141f159f982e8dde0f9b0a6778a8b71)
@@ -52,9 +52,9 @@
#? {Person info parameter syntax -force:switch} "?-force?"
#? {Person info parameter name "a b"} "a"
- set emsg [string cat \
- "wrong # of elements in parameter definition. " \
- "Should be a list of 1 or 2 elements, but got: ''"]
+ set emsg [join [list \
+ "wrong # of elements in parameter definition. " \
+ "Should be a list of 1 or 2 elements, but got: ''"] ""]
foreach subcmd {default syntax type list name} {
? [list nsf::parameter::info $subcmd ""] $emsg
Index: tests/shells.test
===================================================================
diff -u -r4a0eb5eeae386136555d77c233ad9f4a971d71f4 -r1d2bdbea2141f159f982e8dde0f9b0a6778a8b71
--- tests/shells.test (.../shells.test) (revision 4a0eb5eeae386136555d77c233ad9f4a971d71f4)
+++ tests/shells.test (.../shells.test) (revision 1d2bdbea2141f159f982e8dde0f9b0a6778a8b71)
@@ -87,7 +87,7 @@
? [list exec $nxsh -c << "catch {nx::Object eval {exit 1}}"] "child process exited abnormally"
# just 8.6 or newer
- if {[info command try] eq ""} return
+ if {[info command yield] eq ""} return
? [list exec $nxsh -c << [list nx::Object eval {try { exit 6 } \
on break {} {;} \
on return {} {;} \
Index: tests/submethods.test
===================================================================
diff -u -r96e318fb438fdc1bd75b09307fdb535cc93f6323 -r1d2bdbea2141f159f982e8dde0f9b0a6778a8b71
--- tests/submethods.test (.../submethods.test) (revision 96e318fb438fdc1bd75b09307fdb535cc93f6323)
+++ tests/submethods.test (.../submethods.test) (revision 1d2bdbea2141f159f982e8dde0f9b0a6778a8b71)
@@ -945,21 +945,21 @@
nx::test case ensemble-forwards {
set C [nx::Class new {
- set handle [:forward "foo 1" string cat %method]
+ set handle [:forward "foo 1" join %method ""]
? [list info commands $handle] $handle
- set handle [:public forward "foo 2" string cat %method]
+ set handle [:public forward "foo 2" join %method ""]
? [list info commands $handle] $handle
- set handle [:protected forward "foo 3" string cat %method]
+ set handle [:protected forward "foo 3" join %method ""]
? [list info commands $handle] $handle
- set handle [:private forward "foo 4" string cat %method]
+ set handle [:private forward "foo 4" join %method ""]
? [list info commands $handle] $handle
- set handle [:object forward "foo 5" string cat %method]
+ set handle [:object forward "foo 5" join %method ""]
? [list info commands $handle] $handle
- set handle [:public object forward "foo 6" string cat %method]
+ set handle [:public object forward "foo 6" join %method ""]
? [list info commands $handle] $handle
- set handle [:protected object forward "foo 7" string cat %method]
+ set handle [:protected object forward "foo 7" join %method ""]
? [list info commands $handle] $handle
- set handle [:private object forward "foo 8" string cat %method]
+ set handle [:private object forward "foo 8" join %method ""]
? [list info commands $handle] $handle
}]