summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2008-03-07 19:04:10 (GMT)
committerdgp <dgp@users.sourceforge.net>2008-03-07 19:04:10 (GMT)
commitea543514a76dcfffcd2d1f5e8dabd47f53d5c442 (patch)
tree9f4ec561c59f9bcd19e57a2f5e5b76a231ee2359
parentf0e746268c48dbf848ef7e9fdba497fd31eb616c (diff)
downloadtcl-ea543514a76dcfffcd2d1f5e8dabd47f53d5c442.zip
tcl-ea543514a76dcfffcd2d1f5e8dabd47f53d5c442.tar.gz
tcl-ea543514a76dcfffcd2d1f5e8dabd47f53d5c442.tar.bz2
* tests/execute.test (execute-6.*): More tests checking that
script bytecode is invalidated in the right situations.
-rw-r--r--tests/execute.test114
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