summaryrefslogtreecommitdiffstats
path: root/tests/parse.test
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2006-02-28 15:44:35 (GMT)
committerdgp <dgp@users.sourceforge.net>2006-02-28 15:44:35 (GMT)
commitaea6c6f98570eb34604011e06d7fc4d5b9cc256a (patch)
tree0b98b7f4840ce4ea0d3d4c45a12c943727b140a3 /tests/parse.test
parent07a404f12e65c2c31b9f326556b7067abd8c9548 (diff)
downloadtcl-aea6c6f98570eb34604011e06d7fc4d5b9cc256a.zip
tcl-aea6c6f98570eb34604011e06d7fc4d5b9cc256a.tar.gz
tcl-aea6c6f98570eb34604011e06d7fc4d5b9cc256a.tar.bz2
* generic/tclBasic.c: Corrections to be sure that TCL_EVAL_GLOBAL
* tests/parse.test: evaluations act the same as [uplevel #0] * tests/trace.test: evaluations, even when execution traces or invocations of [::unknown] are present. [Bug 1439836].
Diffstat (limited to 'tests/parse.test')
-rw-r--r--tests/parse.test55
1 files changed, 45 insertions, 10 deletions
diff --git a/tests/parse.test b/tests/parse.test
index 124ab0f..dae14e9 100644
--- a/tests/parse.test
+++ b/tests/parse.test
@@ -8,10 +8,10 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: parse.test,v 1.11.2.2 2005/03/18 16:33:43 dgp Exp $
+# RCS: @(#) $Id: parse.test,v 1.11.2.3 2006/02/28 15:44:36 dgp Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+ package require tcltest 2
namespace import -force ::tcltest::*
}
@@ -218,16 +218,17 @@ test parse-7.1 {Tcl_FreeParse and ExpandTokenArray procedures} {
testparser {$a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) } 0
} {- {$a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) } 16 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 {}}
-test parse-8.1 {Tcl_EvalObjv procedure} {
+testConstraint testevalobjv [llength [info commands testevalobjv]]
+test parse-8.1 {Tcl_EvalObjv procedure} testevalobjv {
testevalobjv 0 concat this is a test
} {this is a test}
-test parse-8.2 {Tcl_EvalObjv procedure, unknown commands} {
+test parse-8.2 {Tcl_EvalObjv procedure, unknown commands} testevalobjv {
rename unknown unknown.old
set x [catch {testevalobjv 10 asdf poiu} msg]
rename unknown.old unknown
list $x $msg
} {1 {invalid command name "asdf"}}
-test parse-8.3 {Tcl_EvalObjv procedure, unknown commands} {
+test parse-8.3 {Tcl_EvalObjv procedure, unknown commands} testevalobjv {
rename unknown unknown.old
proc unknown args {
return "unknown $args"
@@ -237,7 +238,7 @@ test parse-8.3 {Tcl_EvalObjv procedure, unknown commands} {
rename unknown.old unknown
list $x $msg
} {0 {unknown asdf poiu}}
-test parse-8.4 {Tcl_EvalObjv procedure, unknown commands} {
+test parse-8.4 {Tcl_EvalObjv procedure, unknown commands} testevalobjv {
rename unknown unknown.old
proc unknown args {
error "I don't like that command"
@@ -247,11 +248,11 @@ test parse-8.4 {Tcl_EvalObjv procedure, unknown commands} {
rename unknown.old unknown
list $x $msg
} {1 {I don't like that command}}
-test parse-8.5 {Tcl_EvalObjv procedure, command traces} {
+test parse-8.5 {Tcl_EvalObjv procedure, command traces} testevalobjv {
testevalobjv 0 set x 123
testcmdtrace tracetest {testevalobjv 0 set x $x}
} {{testevalobjv 0 set x $x} {testevalobjv 0 set x 123} {set x 123} {set x 123}}
-test parse-8.7 {Tcl_EvalObjv procedure, TCL_EVAL_GLOBAL flag} {
+test parse-8.7 {Tcl_EvalObjv procedure, TCL_EVAL_GLOBAL flag} testevalobjv {
proc x {} {
set y 23
set z [testevalobjv 1 set y]
@@ -261,7 +262,7 @@ test parse-8.7 {Tcl_EvalObjv procedure, TCL_EVAL_GLOBAL flag} {
set y 16
x
} {16 23}
-test parse-8.8 {Tcl_EvalObjv procedure, async handlers} {
+test parse-8.8 {Tcl_EvalObjv procedure, async handlers} testevalobjv {
proc async1 {result code} {
global aresult acode
set aresult $result
@@ -275,9 +276,43 @@ test parse-8.8 {Tcl_EvalObjv procedure, async handlers} {
testasync delete
set x
} {0 {new result} 0 original}
-test parse-8.9 {Tcl_EvalObjv procedure, exceptional return} {
+test parse-8.9 {Tcl_EvalObjv procedure, exceptional return} testevalobjv {
list [catch {testevalobjv 0 error message} msg] $msg
} {1 message}
+test parse-8.10 {Tcl_EvalObjv procedure, TCL_EVAL_GLOBAL} testevalobjv {
+ rename ::unknown unknown.save
+ proc ::unknown args {lappend ::info [info level]}
+ catch {rename ::noSuchCommand {}}
+ set ::info {}
+ namespace eval test_ns_1 {
+ testevalobjv 1 noSuchCommand
+ uplevel #0 noSuchCommand
+ }
+ namespace delete test_ns_1
+ rename ::unknown {}
+ rename unknown.save ::unknown
+ set ::info
+} {1 1}
+test parse-8.11 {Tcl_EvalObjv procedure, TCL_EVAL_INVOKE} testevalobjv {
+ rename ::unknown unknown.save
+ proc ::unknown args {lappend ::info [info level]; uplevel 1 foo}
+ proc ::foo args {lappend ::info global}
+ catch {rename ::noSuchCommand {}}
+ set ::slave [interp create]
+ $::slave alias bar noSuchCommand
+ set ::info {}
+ namespace eval test_ns_1 {
+ proc foo args {lappend ::info namespace}
+ $::slave eval bar
+ testevalobjv 1 [list $::slave eval bar]
+ uplevel #0 [list $::slave eval bar]
+ }
+ namespace delete test_ns_1
+ rename ::foo {}
+ rename ::unknown {}
+ rename unknown.save ::unknown
+ set ::info
+} [subst {[set level 2; incr level [info level]] namespace 1 global 1 global}]
test parse-9.1 {Tcl_LogCommandInfo, line numbers} {
catch {unset x}