summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorhobbs <hobbs>1999-12-12 02:27:03 (GMT)
committerhobbs <hobbs>1999-12-12 02:27:03 (GMT)
commitcd9655fd919cf88d1b2f8ea9a542de1ba6e5649a (patch)
tree078213736e63a3187028984e721a7b538db27df4
parent9d5c1c3ab0220165e8761184bf18b03a0018c0e8 (diff)
downloadtcl-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.
-rw-r--r--tests/info.test35
-rw-r--r--tests/parseOld.test4
-rw-r--r--tests/var.test17
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}