diff options
Diffstat (limited to 'tests/parse.test')
| -rw-r--r-- | tests/parse.test | 55 |
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} |