Index: generic/nsf.c
===================================================================
diff -u -rdc94a1f141b1c6a106d0ee142c9df2743ac82e67 -r5ab2ad98d7e3d8509a26ea32ec64fa9cc78af2f8
--- generic/nsf.c (.../nsf.c) (revision dc94a1f141b1c6a106d0ee142c9df2743ac82e67)
+++ generic/nsf.c (.../nsf.c) (revision 5ab2ad98d7e3d8509a26ea32ec64fa9cc78af2f8)
@@ -29089,6 +29089,7 @@
} else {
char *errMsg = ObjStr(Tcl_GetObjResult(interp));
+ Tcl_SetErrorCode(interp, "NSF", "VALUE", "CONSTRAINT", NULL);
if (*errMsg == '\0') {
return NsfPrintError(interp, "invalid value constraints \"%s\"",
ObjStr(paramObjPtr) );
Index: library/lib/nx-test.tcl
===================================================================
diff -u -r464ec0a020a47ef504e143ad0e0c5d0990044488 -r5ab2ad98d7e3d8509a26ea32ec64fa9cc78af2f8
--- library/lib/nx-test.tcl (.../nx-test.tcl) (revision 464ec0a020a47ef504e143ad0e0c5d0990044488)
+++ library/lib/nx-test.tcl (.../nx-test.tcl) (revision 5ab2ad98d7e3d8509a26ea32ec64fa9cc78af2f8)
@@ -123,12 +123,29 @@
:exitOn
if {[info exists :pre]} {:call "pre" ${:pre}}
if {![info exists :msg]} {set :msg ${:cmd}}
- set gotError [catch {:call "run" ${:cmd}} r]
+ #set gotError [catch {:call "run" ${:cmd}} r]
+ try {
+ :call run ${:cmd}
+ } on error {errorMsg opts} {
+ set errorCode [dict get $opts -errorcode]
+ if {$errorCode ne "NONE"} {
+ set r $errorMsg
+ } else {
+ set r $errorMsg
+ }
+ set gotError 1
+ } on ok {r} {
+ set gotError 0
+ set errorCode "NONE"
+ }
#puts stderr "gotError = $gotError // $r == ${:expected} // [info exists :setResult]"
if {[info exists :setResult]} {set r [eval [set :setResult]]}
- if {$r eq ${:expected}} {
+ if {$r eq ${:expected} || $errorCode eq ${:expected}} {
if {$gotError} {
set c 1
+ if {$errorCode ne "NONE" && $errorCode ne ${:expected}} {
+ puts stderr "[set :name] hint: we could compare with errorCode: $errorCode"
+ }
} else {
if {[info exists :count]} {set c ${:count}} {set c 1000}
}
Index: tests/destroy.test
===================================================================
diff -u -rc4f449cb353be812ba6502ef8e9587e87881f59b -r5ab2ad98d7e3d8509a26ea32ec64fa9cc78af2f8
--- tests/destroy.test (.../destroy.test) (revision c4f449cb353be812ba6502ef8e9587e87881f59b)
+++ tests/destroy.test (.../destroy.test) (revision 5ab2ad98d7e3d8509a26ea32ec64fa9cc78af2f8)
@@ -161,7 +161,7 @@
puts stderr "AAAA [current] exists [::nsf::object::exists [current]]"
:set x 1
#? "[current] set x" 1 "$::case can still access [current]"
- ? "[current] set x" {can't read "x": no such variable} "$::case cannot access [current]"
+ ? "[current] set x" {TCL LOOKUP VARNAME x} "$::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"
Index: tests/forward.test
===================================================================
diff -u -rbc7f267ac8f8439d87c710917eabcd6f65f22816 -r5ab2ad98d7e3d8509a26ea32ec64fa9cc78af2f8
--- tests/forward.test (.../forward.test) (revision bc7f267ac8f8439d87c710917eabcd6f65f22816)
+++ tests/forward.test (.../forward.test) (revision 5ab2ad98d7e3d8509a26ea32ec64fa9cc78af2f8)
@@ -271,7 +271,7 @@
? {obj info object methods foo} ""
obj public object forward ::ns1::foo
? {obj info object methods foo} "foo"
- ? {obj foo X} {invalid command name "::ns1::foo"}
+ ? {obj foo X} {TCL LOOKUP COMMAND ::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,14 +354,14 @@
? {obj foo 1 2 3} [list 1 2 3 %]
obj public object forward foo list {%obj foo}
- ? {obj foo 1 2 3} "too many nested evaluations (infinite loop?)"
+ ? {obj foo 1 2 3} "TCL LIMIT STACK" "stack overflow"
obj public object forward foo list {%apply {{x} {return $x}} A}
? {obj foo 1 2 3} [list A 1 2 3]
## positioning of "simple" cmd substitution works fine
obj public object forward foo list {%@end %obj}
- ? {obj foo 1 2 3} [list 1 2 3 ::obj]
+ ? {obj foo 1 2 3} [list 1 2 3 ::obj] "simple cmd substitution by position"
## lindex allows for omitting the index arg or passing {} as index value ... forward catches both cases nicely:
obj public object forward foo list {%@{} %obj}
@@ -376,28 +376,27 @@
##
obj public object forward foo list {%@end %::proc}
- ? {obj foo 1 2 3} {wrong # args: should be "::proc name args body"}
+ ? {obj foo 1 2 3} {TCL WRONGARGS} "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}
+ # obj public object forward foo list {%@end %::self}
#? {obj foo 1 2 3} [list 1 2 3 ::obj]
obj public object forward foo list {%@end %::nx::self}
? {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} {invalid command name "::1"}
+ ? {obj foo 1 2 3} {TCL LOOKUP COMMAND ::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} {invalid command name "@1"}
+ ? {obj foo 1 2 3} {TCL LOOKUP COMMAND @1} "forward to non-existing cmd"
if {![string length "ISSUES"]} {
-
## list protection makes this fail
obj public object forward foo list {%@end {%argclindex {A B C D}}}
? {obj foo 1 2 3} [list 1 2 3 D]
@@ -448,7 +447,7 @@
nx::Object public method f args { next }
- nx::Class create NS
+ nx::Class create NS
nx::Class create NS::Main {
:public object method m1 {} { :m2 }
:public object method m2 {} {
@@ -537,18 +536,18 @@
}
C create c1
- ? {c1 expr {[current]}} ::c1
- ? {c1 expr {[current] eq "::c1"}} 1
- ? {c1 expr {[:xx]}} ::c1
- ? {c1 expr {[:info class]}} ::C
- ? {c1 expr {[:info has type C]}} 1
- ? {c1 expr {[:info has type ::C]}} 1
+ ? {c1 expr {[current]}} ::c1
+ ? {c1 expr {[current] eq "::c1"}} 1
+ ? {c1 expr {[:xx]}} ::c1
+ ? {c1 expr {[:info class]}} ::C
+ ? {c1 expr {[:info has type C]}} 1
+ ? {c1 expr {[:info has type ::C]}} 1
- ? {C t ::c1 {[current]}} ::c1
+ ? {C t ::c1 {[current]}} ::c1
? {C t ::c1 {[current] eq "::c1"}} 1
- ? {C t ::c1 {[:xx]}} ::c1
+ ? {C t ::c1 {[:xx]}} ::c1
? {C t ::c1 {[:info class]}} ::C
- ? {C t ::c1 {[:info has type C]}} 1
+ ? {C t ::c1 {[:info has type C]}} 1
? {C t ::c1 {[:info has type ::C]}} 1
nx::Object method expr {} {}