diff options
Diffstat (limited to 'tests/compile.test')
| -rw-r--r-- | tests/compile.test | 28 |
1 files changed, 15 insertions, 13 deletions
diff --git a/tests/compile.test b/tests/compile.test index ac95c25..36b4f3a 100644 --- a/tests/compile.test +++ b/tests/compile.test @@ -5,8 +5,8 @@ # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # -# Copyright (c) 1997 by Sun Microsystems, Inc. -# Copyright (c) 1998-1999 by Scriptics Corporation. +# Copyright © 1997 Sun Microsystems, Inc. +# Copyright © 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -16,8 +16,9 @@ if {"::tcltest" ni [namespace children]} { namespace import -force ::tcltest::* } + ::tcltest::loadTestedCommands -catch [list package require -exact Tcltest [info patchlevel]] +catch [list package require -exact tcl::test [info patchlevel]] testConstraint exec [llength [info commands exec]] testConstraint memory [llength [info commands memory]] @@ -285,10 +286,10 @@ test compile-7.1 {TclCompileWhileCmd: command substituted test expression} { } {4} test compile-8.1 {CollectArgInfo: binary data} { - list [catch "string length \000foo" msg] $msg + list [catch "string length \x00foo" msg] $msg } {0 4} test compile-8.2 {CollectArgInfo: binary data} { - list [catch "string length foo\000" msg] $msg + list [catch "string length foo\x00" msg] $msg } {0 4} test compile-8.3 {CollectArgInfo: handle "]" at end of command properly} { set x ] @@ -499,7 +500,7 @@ test compile-13.2 {TclCompileScript: testing expected nested scripts compilation # with 1500 (1000 in debug) nested scripts (bodies). If you get SO/SF exceptions on some low-stack # boxes or systems, please don't decrease it (either provide a constraint) ti eval {foreach cmd {eval "if 1" try catch} { - set c [gencode [expr {![::tcl::pkgconfig get debug] ? 1500 : 1000}] $cmd] + set c [gencode [expr {[tcl::build-info debug] ? 1500 : 1000}] $cmd] if 1 $c }} ti eval {set result} @@ -562,7 +563,8 @@ test compile-15.5 {proper TCL_RETURN code from [return]} { apply {{} {catch {set a 1}; return}} } "" -for {set noComp 0} {$noComp <= 1} {incr noComp} { +# Do all tests once byte compiled and once with direct string evaluation +foreach noComp {0 1} { if {$noComp} { interp alias {} run {} testevalex @@ -650,26 +652,26 @@ test compile-16.18.$noComp {TclCompileScript: word expansion} -body { llength [run "list [string repeat {{*}[LongList] } [expr {1<<10}]]"] } -constraints [linsert $constraints 0 knownBug] -cleanup { rename LongList {} -} -returnCodes ok -result [expr {1<<20}] +} -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 {{*}[LongList] } [expr {1<<11}]]"] } -constraints [linsert $constraints 0 knownBug] -cleanup { rename LongList {} -} -returnCodes ok -result [expr {1<<22}] +} -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 {{*}[LongList] } [expr {1<<12}]]"] } -constraints [linsert $constraints 0 knownBug] -cleanup { rename LongList {} -} -returnCodes ok -result [expr {1<<24}] +} -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 {{*}[LongList] } [expr {1<<16}]]"] } -constraints [linsert $constraints 0 knownBug] -cleanup { rename LongList {} -} -returnCodes ok -result [expr {wide(1)<<32}] +} -result [expr {wide(1)<<32}] test compile-16.22.$noComp { Bug 845412: TclCompileScript: word expansion not mandatory } -body { @@ -678,7 +680,7 @@ test compile-16.22.$noComp { run "ReturnResults [string repeat {x } 260]" } -constraints $constraints -cleanup { rename ReturnResults {} -} -returnCodes ok -result [string trim [string repeat {x } 260]] +} -result [string trim [string repeat {x } 260]] test compile-16.23.$noComp { Bug 1032805: defer parse error until run time } -constraints $constraints -body { @@ -690,7 +692,7 @@ test compile-16.23.$noComp { } } -cleanup { namespace delete x -} -returnCodes ok -result {syntax {}{}} +} -result {syntax {}{}} test compile-16.24.$noComp { Bug 1638414: bad list constant as first expanded term } -constraints $constraints -body { |