diff options
author | dgp <dgp@users.sourceforge.net> | 2003-11-14 20:44:43 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2003-11-14 20:44:43 (GMT) |
commit | 17f540b256d78b8a6fc8bd9121a633dac6c23b19 (patch) | |
tree | 1abdc7a020d4095171e8cb7f16def9be025cb664 /tests/compile.test | |
parent | f745c9aa31bbdf8f71589fa25d30ce50cad94652 (diff) | |
download | tcl-17f540b256d78b8a6fc8bd9121a633dac6c23b19.zip tcl-17f540b256d78b8a6fc8bd9121a633dac6c23b19.tar.gz tcl-17f540b256d78b8a6fc8bd9121a633dac6c23b19.tar.bz2 |
* doc/ParseCmd.3: Implementation of TIP 157. Adds recognition
* doc/Tcl.n: of the new leading {expand} syntax on words.
* generic/tcl.h: Parses such words as the new Tcl_Token type
* generic/tclBasic.c: TCL_TOKEN_EXPAND_WORD. Updated Tcl_EvalEx
* generic/tclCompile.c: and the bytecode compiler/execution engine
* generic/tclCompile.h: to recognize the new token type. New opcodes
* generic/tclExecute.c: INST_LIST_VERIFY and INST_INVOKE_EXP and a new
* generic/tclParse.c: operand type OPERAND_ULIST1 are defined. Docs
* generic/tclTest.c: and tests are included.
* tests/basic.test:
* tests/compile.test:
* tests/parse.test:
* library/auto.tcl: Replaced several [eval]s used to perform
* library/package.tcl: argument expansion with the new syntax.
* library/safe.tcl: In the test files lindex.test and lset.test,
* tests/cmdInfo.test: replaced use of [eval] to force direct
* tests/encoding.test: string evaluation with use of [testevalex]
* tests/execute.test: which more directly and robustly serves the
* tests/fCmd.test: same purpose.
* tests/http.test:
* tests/init.test:
* tests/interp.test:
* tests/io.test:
* tests/ioUtil.test:
* tests/iogt.test:
* tests/lindex.test:
* tests/lset.test:
* tests/namespace-old.test:
* tests/namespace.test:
* tests/pkg.test:
* tests/pkgMkIndex.test:
* tests/proc.test:
* tests/reg.test:
* tests/trace.test:
* tests/upvar.test:
* tests/winConsole.test:
* tests/winFCmd.test:
Diffstat (limited to 'tests/compile.test')
-rw-r--r-- | tests/compile.test | 139 |
1 files changed, 135 insertions, 4 deletions
diff --git a/tests/compile.test b/tests/compile.test index 8559b24..1fb445c 100644 --- a/tests/compile.test +++ b/tests/compile.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: compile.test,v 1.27 2003/05/09 13:42:40 msofer Exp $ +# RCS: @(#) $Id: compile.test,v 1.28 2003/11/14 20:44:46 dgp Exp $ package require tcltest 2 namespace import -force ::tcltest::* @@ -274,9 +274,9 @@ test compile-11.9 {Tcl_Append*: ensure Tcl_ResetResult is used properly} { # # Special test for leak on interp delete [Bug 467523]. ::tcltest::testConstraint exec [llength [info commands exec]] -::tcltest::testConstraint memDebug [llength [info commands memory]] +::tcltest::testConstraint memory [llength [info commands memory]] -test compile-12.1 {testing literal leak on interp delete} {memDebug} { +test compile-12.1 {testing literal leak on interp delete} {memory} { proc getbytes {} { set lines [split [memory info] "\n"] lindex [lindex $lines 3] 3 @@ -298,7 +298,7 @@ test compile-12.1 {testing literal leak on interp delete} {memDebug} { # Special test for a memory error in a preliminary fix of [Bug 467523]. # It requires executing a helpfile. Presumably the child process is # used because when this test fails, it crashes. -test compile-12.2 {testing error on literal deletion} {memDebug exec} { +test compile-12.2 {testing error on literal deletion} {memory exec} { makeFile { for {set i 0} {$i < 5} {incr i} { namespace eval bar {} @@ -373,6 +373,137 @@ test compile-15.5 {proper TCL_RETURN code from [return]} { set result } "" +testConstraint testevalex [llength [info commands testevalex]] +for {set noComp 1} {$noComp <= 1} {incr noComp} { + +if $noComp { + interp alias {} run {} testevalex + set constraints testevalex +} else { + interp alias {} run {} if 1 + set constraints {} +} + +test compile-16.1.$noComp {TclCompileScript: word expansion} $constraints { + run "list [string repeat {{expand}a } 255]" +} [lrepeat 255 a] + +test compile-16.2.$noComp {TclCompileScript: word expansion} $constraints { + run "list [string repeat {{expand}a } 256]" +} [lrepeat 256 a] + +test compile-16.3.$noComp {TclCompileScript: word expansion} $constraints { + run "list [string repeat {{expand}a } 257]" +} [lrepeat 257 a] + +test compile-16.4.$noComp {TclCompileScript: word expansion} $constraints { + run {{expand}list} +} {} + +test compile-16.5.$noComp {TclCompileScript: word expansion} $constraints { + run {{expand}list {expand}{x y z}} +} {x y z} + +test compile-16.6.$noComp {TclCompileScript: word expansion} $constraints { + run {{expand}list {expand}[list x y z]} +} {x y z} + +test compile-16.7.$noComp {TclCompileScript: word expansion} $constraints { + run {{expand}list {expand}[list x y z][list x y z]} +} {x y zx y z} + +test compile-16.8.$noComp {TclCompileScript: word expansion} -body { + set l {x y z} + run {{expand}list {expand}$l} +} -constraints $constraints -cleanup { + unset l +} -result {x y z} + +test compile-16.9.$noComp {TclCompileScript: word expansion} -body { + set l {x y z} + run {{expand}list {expand}$l$l} +} -constraints $constraints -cleanup { + unset l +} -result {x y zx y z} + +test compile-16.10.$noComp {TclCompileScript: word expansion} -body { + run {{expand}\{} +} -constraints $constraints -returnCodes error \ +-result {unmatched open brace in list} + +test compile-16.11.$noComp {TclCompileScript: word expansion} -body { + proc badList {} {return \{} + run {{expand}[badList]} +} -constraints $constraints -cleanup { + rename badList {} +} -returnCodes error -result {unmatched open brace in list} + +test compile-16.12.$noComp {TclCompileScript: word expansion} $constraints { + run {{expand}list x y z} +} {x y z} + +test compile-16.13.$noComp {TclCompileScript: word expansion} $constraints { + run {{expand}list x y {expand}z} +} {x y z} + +test compile-16.14.$noComp {TclCompileScript: word expansion} $constraints { + run {{expand}list x {expand}y z} +} {x y z} + +test compile-16.15.$noComp {TclCompileScript: word expansion} $constraints { + run {list x y {expand}z} +} {x y z} + +test compile-16.16.$noComp {TclCompileScript: word expansion} $constraints { + run {list x {expand}y z} +} {x y z} + +test compile-16.17.$noComp {TclCompileScript: word expansion} $constraints { + run {list {expand}x y z} +} {x y z} + +# These tests note that expansion can in theory cause the number of +# arguments to a command to exceed INT_MAX, which is as big as objc +# is allowed to get. +# +# In practice, it seems we will run out of memory before we confront +# this issue. Note that compiled operations run out of memory at +# smaller objc values than direct string evaluation. +# +# These tests are constrained as knownBug because they are likely +# to cause memory allocation panics somewhere, and we don't want +# panics in the test suite. +# +test compile-16.18.$noComp {TclCompileScript: word expansion} -body { + proc LongList {} {return [lrepeat [expr {1<<10}] x]} + llength [run "list [string repeat {{expand}[LongList] } [expr {1<<10}]]"] +} -constraints [linsert $constraints 0 knownBug] -cleanup { + rename LongList {} +} -returnCodes ok -result [expr {1<<20}] + +test compile-16.19.$noComp {TclCompileScript: word expansion} -body { + proc LongList {} {return [lrepeat [expr {1<<11}] x]} + llength [run "list [string repeat {{expand}[LongList] } [expr {1<<11}]]"] +} -constraints [linsert $constraints 0 knownBug] -cleanup { + rename LongList {} +} -returnCodes ok -result [expr {1<<22}] + +test compile-16.20.$noComp {TclCompileScript: word expansion} -body { + proc LongList {} {return [lrepeat [expr {1<<12}] x]} + llength [run "list [string repeat {{expand}[LongList] } [expr {1<<12}]]"] +} -constraints [linsert $constraints 0 knownBug] -cleanup { + rename LongList {} +} -returnCodes ok -result [expr {1<<24}] + +# This is the one that should cause overflow +test compile-16.21.$noComp {TclCompileScript: word expansion} -body { + proc LongList {} {return [lrepeat [expr {1<<16}] x]} + llength [run "list [string repeat {{expand}[LongList] } [expr {1<<16}]]"] +} -constraints [linsert $constraints 0 knownBug] -cleanup { + rename LongList {} +} -returnCodes ok -result [expr {wide(1)<<32}] + +} ;# End of noComp loop # cleanup catch {rename p ""} |