* tests/execute.test (execute-6.*): More tests checking that

        script bytecode is invalidated in the right situations.

1 files changed, 97 insertions, 17 deletions

diff --git a/tests/execute.test b/tests/execute.test
index eea8bb4..a43e8e6 100644
--- a/tests/execute.test
+++ b/tests/execute.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: execute.test,v 1.26 2008/03/07 15:28:28 dgp Exp $
+# RCS: @(#) $Id: execute.test,v 1.27 2008/03/07 19:04:10 dgp Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -34,7 +34,7 @@ testConstraint testobj [expr {
 }]
 
 testConstraint longIs32bit [expr {int(0x80000000) < 0}]
-testConstraint testevalex [llength [info commands testevalex]]
+testConstraint testexprlongobj [llength [info commands testexprlongobj]]
 
 # Tests for the omnibus TclExecuteByteCode function:
 
@@ -672,21 +672,101 @@ test execute-6.10 {TclCompEvalObj: bytecode interp validation} {
     interp delete slave
     set result
 } {0 0}
-# Still trying to craft this one...
-#test execute-6.11 {Tcl_ExprObj: exprcode interp validation} testevalex {
-#    set e { [llength {}]+1 }
-#    set result {}
-#    interp create slave
-#    load {} Tcltest slave
-#    slave eval [list testevalex [listZZproc e e {set expr expr; $expr $e}}
-#    lappend result [slave eval [list e $e]]
-#    interp delete slave
-#    interp create slave
-#    slave eval {proc e e {expr $e}}
-#    lappend result [slave eval [list e $e]]
-#    interp delete slave
-#    set result
-#} {1 1}
+test execute-6.11 {Tcl_ExprObj: exprcode interp validation} testexprlongobj {
+    set e { [llength {}]+1 }
+    set result {}
+    interp create slave
+    load {} Tcltest slave
+    interp alias {} e slave testexprlongobj
+    lappend result [e $e]
+    interp delete slave
+    interp create slave
+    load {} Tcltest slave
+    interp alias {} e slave testexprlongobj
+    lappend result [e $e]
+    interp delete slave
+    set result
+} {{This is a result: 1} {This is a result: 1}}
+test execute-6.12 {Tcl_ExprObj: exprcode interp validation} {
+    set e { [llength {}]+1 }
+    set result {}
+    interp create slave
+    interp alias {} e slave expr
+    lappend result [e $e]
+    interp delete slave
+    interp create slave
+    interp alias {} e slave expr 
+    lappend result [e $e]
+    interp delete slave
+    set result
+} {1 1}
+test execute-6.13 {Tcl_ExprObj: exprcode epoch validation} {
+    set e { [llength {}]+1 }
+    set result {}
+    lappend result [expr $e]
+    set origName [namespace which llength]
+    rename $origName llength.orig
+    proc $origName {args} {return 1}
+    lappend result [expr $e]
+    rename $origName {}
+    rename llength.orig $origName
+    set result
+} {1 2}
+test execute-6.14 {Tcl_ExprObj: exprcode context validation} {
+    set e { [llength {}]+1 }
+    namespace eval foo {
+	proc llength {args} {return 1}
+    }
+    set result {}
+    lappend result [expr $e]
+    lappend result [namespace eval foo {expr $e}]
+    namespace delete foo
+    set result
+} {1 2}
+test execute-6.15 {Tcl_ExprObj: exprcode name resolution epoch validation} {
+    set e { [llength {}]+1 }
+    set result {}
+    lappend result [namespace eval foo {expr $e}]
+    namespace eval foo {
+	proc llength {args} {return 1}
+    }
+    lappend result [namespace eval foo {expr $e}]
+    namespace delete foo
+    set result
+} {1 2}
+test execute-6.16 {Tcl_ExprObj: exprcode interp validation} {
+    set e { [llength {}]+1 }
+    interp create slave
+    interp alias {} e slave expr
+    slave eval {proc llength args {return 1}}
+    set result {}
+    lappend result [expr $e]
+    lappend result [e $e]
+    interp delete slave
+    set result
+} {1 2}
+test execute-6.17 {Tcl_ExprObj: exprcode context validation} {
+    set e { $v }
+    proc foo e {set v 0; expr $e}
+    proc bar e {set v 1; expr $e}
+    set result {}
+    lappend result [foo $e]
+    lappend result [bar $e]
+    rename foo {}
+    rename bar {}
+    set result
+} {0 1}
+test execute-6.18 {Tcl_ExprObj: exprcode context validation} {
+    set e { [llength $v] }
+    proc foo e {set v {}; expr $e}
+    proc bar e {set v v; expr $e}
+    set result {}
+    lappend result [foo $e]
+    lappend result [bar $e]
+    rename foo {}
+    rename bar {}
+    set result
+} {0 1}
 
 test execute-7.0 {Wide int handling in INST_JUMP_FALSE/LAND} {
     set x 0x100000000