diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/info.test | 35 | ||||
| -rw-r--r-- | tests/parseOld.test | 4 | ||||
| -rw-r--r-- | tests/var.test | 17 |
3 files changed, 35 insertions, 21 deletions
diff --git a/tests/info.test b/tests/info.test index 908c0ea..9297931 100644 --- a/tests/info.test +++ b/tests/info.test @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: info.test,v 1.11 1999/07/31 01:55:51 redman Exp $ +# RCS: @(#) $Id: info.test,v 1.12 1999/12/12 02:27:03 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -80,16 +80,27 @@ test info-2.4 {info body option} { } } {{return "x=$x"} {return "y=$y"}} -# "info cmdcount" is no longer accurate for compiled commands! The expected -# result for info-3.1 used to be "3" and is now "1" since the "set"s have -# been compiled away. -test info-3.1 {info cmdcount option} { +# "info cmdcount" is no longer accurate for compiled commands! +# The expected result for info-3.1 used to be "3" and is now "1" +# since the "set"s have been compiled away. info-3.2 was corrected +# in 8.3 because the eval'ed body won't be compiled. +proc testinfocmdcount {} { set x [info cmdcount] set y 12345 set z [info cm] expr $z-$x +} +test info-3.1 {info cmdcount compiled} { + testinfocmdcount } 1 -test info-3.2 {info cmdcount option} { +test info-3.2 {info cmdcount evaled} { + set x [info cmdcount] + set y 12345 + set z [info cm] + expr $z-$x +} 3 +test info-3.3 {info cmdcount evaled} [info body testinfocmdcount] 3 +test info-3.4 {info cmdcount option} { list [catch {info cmdcount 1} msg] $msg } {1 {wrong # args: should be "info cmdcount"}} @@ -510,15 +521,3 @@ test info-20.5 {miscellaneous error conditions} { catch {namespace delete test_ns_info1 test_ns_info2} ::tcltest::cleanupTests return - - - - - - - - - - - - diff --git a/tests/parseOld.test b/tests/parseOld.test index a692bbb..2f6a4b2 100644 --- a/tests/parseOld.test +++ b/tests/parseOld.test @@ -13,7 +13,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: parseOld.test,v 1.7 1999/08/23 17:54:59 jenn Exp $ +# RCS: @(#) $Id: parseOld.test,v 1.8 1999/12/12 02:27:04 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -348,7 +348,7 @@ test parseOld-10.13 {syntax errors} { test parseOld-10.14 {syntax errors} { list [catch {eval \$x[format "%01000d" 0](} msg] $msg $errorInfo } {1 {missing )} {missing ) - while compiling + while executing "$x0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000..." ("eval" body line 1) invoked from within diff --git a/tests/var.test b/tests/var.test index af962a8..b18e0ae 100644 --- a/tests/var.test +++ b/tests/var.test @@ -14,7 +14,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: var.test,v 1.9 1999/09/21 04:20:45 hobbs Exp $ +# RCS: @(#) $Id: var.test,v 1.10 1999/12/12 02:27:04 hobbs Exp $ # if {[lsearch [namespace children] ::tcltest] == -1} { @@ -602,6 +602,21 @@ test var-11.3 {array unset errors} { list [catch {array unset a pattern too} msg] $msg } {1 {wrong # args: should be "array unset arrayName ?pattern?"}} +test var-12.1 {TclFindCompiledLocals, {} array name} { + namespace eval n { + proc p {} { + variable {} + set (0) 0 + set (1) 1 + set n 2 + set ($n) 2 + set ($n,foo) 2 + } + p + lsort -dictionary [array names {}] + } +} {0 1 2 2,foo} + catch {namespace delete ns} catch {unset arr} catch {unset v} |