summaryrefslogtreecommitdiffstats
path: root/tests
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 /tests
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.
Diffstat (limited to 'tests')
-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}