diff options
author | hobbs <hobbs> | 1999-12-12 02:27:03 (GMT) |
---|---|---|
committer | hobbs <hobbs> | 1999-12-12 02:27:03 (GMT) |
commit | cd9655fd919cf88d1b2f8ea9a542de1ba6e5649a (patch) | |
tree | 078213736e63a3187028984e721a7b538db27df4 /tests | |
parent | 9d5c1c3ab0220165e8761184bf18b03a0018c0e8 (diff) | |
download | tcl-cd9655fd919cf88d1b2f8ea9a542de1ba6e5649a.zip tcl-cd9655fd919cf88d1b2f8ea9a542de1ba6e5649a.tar.gz tcl-cd9655fd919cf88d1b2f8ea9a542de1ba6e5649a.tar.bz2 |
* tests/info.test:
* tests/parseOld.test:
* generic/tclCmdAH.c:
* generic/tclProc.c: changed Tcl_UplevelObjCmd (uplevel) and
Tcl_EvalObjCmd (eval) to use TCL_EVAL_DIRECT in the single arg
case as well, to take advantage of potential pure list input
optimization. This means that it won't get byte compiled though,
which should be acceptable.
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} |