diff options
| -rw-r--r-- | ChangeLog | 8 | ||||
| -rw-r--r-- | generic/tclBasic.c | 10 | ||||
| -rw-r--r-- | tests/namespace.test | 11 | ||||
| -rw-r--r-- | tests/parse.test | 36 | ||||
| -rw-r--r-- | tests/trace.test | 35 |
5 files changed, 92 insertions, 8 deletions
@@ -1,3 +1,11 @@ +2006-02-28 Don Porter <dgp@users.sourceforge.net> + + * generic/tclBasic.c: Corrections to be sure that TCL_EVAL_GLOBAL + * tests/namespace.test: evaluations act the same as [uplevel #0] + * tests/parse.test: evaluations, even when execution traces or + * tests/trace.test: invocations of [::unknown] are present. + [Bug 1439836]. + 2006-02-22 Don Porter <dgp@users.sourceforge.net> * generic/tclBasic.c: Corrected a few bugs in how [namespace unknown] diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 7744858..dcfedc4 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -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: tclBasic.c,v 1.191 2006/02/22 17:42:04 dgp Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.192 2006/02/28 15:47:10 dgp Exp $ */ #include "tclInt.h" @@ -3348,6 +3348,9 @@ TclEvalObjvInternal( * while loop one more time. */ + if (flags & TCL_EVAL_GLOBAL) { + iPtr->varFramePtr = NULL; + } if (iPtr->tracePtr != NULL && traceCode == TCL_OK) { traceCode = TclCheckInterpTraces(interp, command, length, cmdPtr, code, TCL_TRACE_ENTER_EXEC, objc, objv); @@ -3356,6 +3359,7 @@ TclEvalObjvInternal( traceCode = TclCheckExecutionTraces(interp, command, length, cmdPtr, code, TCL_TRACE_ENTER_EXEC, objc, objv); } + iPtr->varFramePtr = savedVarFramePtr; cmdPtr->refCount--; } if (cmdEpoch != cmdPtr->cmdEpoch) { @@ -3400,6 +3404,9 @@ TclEvalObjvInternal( */ if (!(cmdPtr->flags & CMD_IS_DELETED)) { + if (flags & TCL_EVAL_GLOBAL) { + iPtr->varFramePtr = NULL; + } if ((cmdPtr->flags & CMD_HAS_EXEC_TRACES) && (traceCode == TCL_OK)) { traceCode = TclCheckExecutionTraces(interp, command, length, cmdPtr, code, TCL_TRACE_LEAVE_EXEC, objc, objv); @@ -3408,6 +3415,7 @@ TclEvalObjvInternal( traceCode = TclCheckInterpTraces(interp, command, length, cmdPtr, code, TCL_TRACE_LEAVE_EXEC, objc, objv); } + iPtr->varFramePtr = savedVarFramePtr; } TclCleanupCommand(cmdPtr); diff --git a/tests/namespace.test b/tests/namespace.test index f6092cc..00f5243 100644 --- a/tests/namespace.test +++ b/tests/namespace.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: namespace.test,v 1.55 2006/02/27 19:43:58 dgp Exp $ +# RCS: @(#) $Id: namespace.test,v 1.56 2006/02/28 15:47:10 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -2545,18 +2545,19 @@ test namespace-52.11 {unknown: with TCL_EVAL_INVOKE} -setup { } } catch {rename ::noSuchCommand {}} - set slave [interp create] + set ::slave [interp create] } -body { - $slave alias bar noSuchCommand + $::slave alias bar noSuchCommand namespace eval test_ns_1 { namespace unknown unknown proc unknown args { return FAIL } - $slave eval bar + $::slave eval bar } } -cleanup { - interp delete $slave + interp delete $::slave + unset ::slave namespace delete test_ns_1 rename ::unknown {} rename unknown.save ::unknown diff --git a/tests/parse.test b/tests/parse.test index 8481a6f..fa1f344 100644 --- a/tests/parse.test +++ b/tests/parse.test @@ -8,7 +8,7 @@ # 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.21 2005/05/10 18:35:22 kennykb Exp $ +# RCS: @(#) $Id: parse.test,v 1.22 2006/02/28 15:47:10 dgp Exp $ if {[catch {package require tcltest 2.0.2}]} { puts stderr "Skipping tests in [info script]. tcltest 2.0.2 required." @@ -365,6 +365,40 @@ test parse-8.8 {Tcl_EvalObjv procedure, async handlers} -constraints { 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} testevalex { catch {unset x} diff --git a/tests/trace.test b/tests/trace.test index 7766431..657c86a 100644 --- a/tests/trace.test +++ b/tests/trace.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: trace.test,v 1.47 2005/11/18 23:42:12 msofer Exp $ +# RCS: @(#) $Id: trace.test,v 1.48 2006/02/28 15:47:10 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -19,6 +19,7 @@ if {[lsearch [namespace children] ::tcltest] == -1} { } testConstraint testcmdtrace [llength [info commands testcmdtrace]] +testConstraint testevalobjv [llength [info commands testevalobjv]] # Used for constraining memory leak tests testConstraint memory [llength [info commands memory]] @@ -1594,6 +1595,38 @@ test trace-21.8 {trace execution: leavestep} { set info } {{foo {set b 3} 0 3 leavestep}} +test trace-21.9 {trace execution: TCL_EVAL_GLOBAL} testevalobjv { + trace add execution foo enter soom + proc ::soom args {lappend ::info SUCCESS [info level]} + set ::info {} + namespace eval test_ns_1 { + proc soom args {lappend ::info FAIL [info level]} + # [testevalobjv 1 ...] ought to produce the same + # results as [uplevel #0 ...]. + testevalobjv 1 foo x + uplevel #0 foo x + } + namespace delete test_ns_1 + trace remove execution foo enter soom + set ::info +} {SUCCESS 1 SUCCESS 1} + +test trace-21.10 {trace execution: TCL_EVAL_GLOBAL} testevalobjv { + trace add execution foo leave soom + proc ::soom args {lappend ::info SUCCESS [info level]} + set ::info {} + namespace eval test_ns_1 { + proc soom args {lappend ::info FAIL [info level]} + # [testevalobjv 1 ...] ought to produce the same + # results as [uplevel #0 ...]. + testevalobjv 1 foo x + uplevel #0 foo x + } + namespace delete test_ns_1 + trace remove execution foo leave soom + set ::info +} {SUCCESS 1 SUCCESS 1} + proc factorial {n} { if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] } return 1 |