diff options
| author | jan.nijtmans <nijtmans@users.sourceforge.net> | 2019-09-12 15:03:53 (GMT) |
|---|---|---|
| committer | jan.nijtmans <nijtmans@users.sourceforge.net> | 2019-09-12 15:03:53 (GMT) |
| commit | f38c8594fbc3efd090c3bbc9c35dc90c3351f458 (patch) | |
| tree | b18a311aab3b077a039fe696cca7aa1550d3d873 /tests | |
| parent | 01634e6c3b3a615fe5fec76d364787e3e9607485 (diff) | |
| parent | a9c3a55803118f3a310d26507bc61ea632bedea6 (diff) | |
| download | tcl-f38c8594fbc3efd090c3bbc9c35dc90c3351f458.zip tcl-f38c8594fbc3efd090c3bbc9c35dc90c3351f458.tar.gz tcl-f38c8594fbc3efd090c3bbc9c35dc90c3351f458.tar.bz2 | |
Merge 8.5. Mark a few more tests nonPortable (for 8.5, not to be merged to 8.6!)
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/compile.test | 50 | ||||
| -rw-r--r-- | tests/fCmd.test | 2 | ||||
| -rw-r--r-- | tests/registry.test | 8 |
3 files changed, 45 insertions, 15 deletions
diff --git a/tests/compile.test b/tests/compile.test index a66da22..f027197 100644 --- a/tests/compile.test +++ b/tests/compile.test @@ -424,10 +424,13 @@ test compile-13.1 {testing underestimate of maxStackSize in list cmd} {exec} { # Tests of nested compile (body in body compilation), should not generate stack overflow # (with abnormal program termination), bug [fec0c17d39]: -test compile-13.2 {TclCompileScript: testing nested scripts compilation} -setup { - set i [interp create] - interp recursionlimit $i [expr {10000+50}] - $i eval {proc gencode {nr {cmd eval} {nl 0}} { +proc _ti_gencode {} { + # creates test interpreter on demand with [gencode] generator: + if {[interp exists ti]} { + return + } + interp create ti + ti eval {proc gencode {nr {cmd eval} {nl 0}} { set code "" set e ""; if {$nl} {set e "\n"} for {set i 0} {$i < $nr} {incr i} { @@ -440,18 +443,45 @@ test compile-13.2 {TclCompileScript: testing nested scripts compilation} -setup #puts [format "%% %.40s ... %d bytes" $code [string length $code]] return $code }} +} +test compile-13.2 {TclCompileScript: testing expected nested scripts compilation} -setup { + _ti_gencode + interp recursionlimit ti [expr {10000+50}] + ti eval {set result {}} } -body { # Test different compilation variants (instructions evalStk, invokeStk, etc), - # with 1500 (750 in debug) nested scripts (bodies). If you get SO/SF exceptions on some low-stack + # with 2000 (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) - $i eval {foreach cmd {eval "if 1" catch} { - set c [gencode [expr {![::tcl::pkgconfig get debug] ? 1500 : 750}] $cmd] + ti eval {foreach cmd {eval "if 1" catch} { + set c [gencode [expr {![::tcl::pkgconfig get debug] ? 2000 : 1000}] $cmd] if 1 $c }} - $i eval {set result} -} -result {1 1 1} -cleanup { - interp delete $i + ti eval {set result} +} -result {1 1 1} +test compile-13.3 {TclCompileScript: testing check of max depth by nested scripts compilation} -setup { + _ti_gencode + interp recursionlimit ti 100 + ti eval {set result {}} +} -body { + # Test different compilation variants (instructions evalStk, invokeStk, etc), + # with 500 nested scripts (bodies). It must generate "too many nested compilations" + # error for any variant we're testing here: + ti eval {foreach cmd {eval "if 1" catch} { + set c [gencode [expr {![info exists ::tcl_platform(debug)] ? 2000 : 1000}] $cmd] + lappend errors [catch $c e] $e + }} + #puts $errors + # all of nested calls exceed the limit, so must end with "too many nested compilations" + # (or evaluations, depending on compile method/instruction and "mixed" compile within + # evaliation), so no one succeeds, the result must be empty: + ti eval {set result} +} -result {} +# +# clean up: +if {[interp exists ti]} { + interp delete ti } +rename _ti_gencode {} # Tests compile-14.* for [Bug 599788] [Bug 0c043a175a47da8c2342] test compile-14.1 {testing errors in element name; segfault?} {} { diff --git a/tests/fCmd.test b/tests/fCmd.test index 71bc186..d79ac79 100644 --- a/tests/fCmd.test +++ b/tests/fCmd.test @@ -2551,7 +2551,7 @@ cd [workingDirectory] test fCmd-30.1 {file writable on 'My Documents'} -setup { # Get the localized version of the folder name by looking in the registry. set mydocsname [registry get {HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders} Personal] -} -constraints {win reg} -body { +} -constraints {win reg nonPortable} -body { file writable $mydocsname } -result 1 test fCmd-30.2 {file readable on 'NTUSER.DAT'} -constraints {win} -body { diff --git a/tests/registry.test b/tests/registry.test index 9691b3e..539ba2d 100644 --- a/tests/registry.test +++ b/tests/registry.test @@ -242,7 +242,7 @@ test registry-4.2 {GetKeyNames} {win reg} { registry delete HKEY_CURRENT_USER\\TclFoobar set result } {baz} -test registry-4.3 {GetKeyNames: remote key} {win reg english} { +test registry-4.3 {GetKeyNames: remote key} {win reg nonPortable english} { set hostname [info hostname] registry set \\\\$hostname\\HKEY_CURRENT_USER\\TclFoobar\\baz set result [registry keys \\\\gaspode\\HKEY_CURRENT_USER\\TclFoobar] @@ -535,7 +535,7 @@ test registry-7.3 {GetValueNames} -constraints {win reg} -setup { } -cleanup { registry delete HKEY_CURRENT_USER\\TclFoobar } -result {{} baz blat} -test registry-7.4 {GetValueNames: remote key} -constraints {win reg english} -body { +test registry-7.4 {GetValueNames: remote key} -constraints {win reg nonPortable english} -body { set hostname [info hostname] registry set \\\\$hostname\\HKEY_CURRENT_USER\\TclFoobar baz blat set result [registry values \\\\$hostname\\HKEY_CURRENT_USER\\TclFoobar] @@ -571,7 +571,7 @@ test registry-7.7 {GetValueNames: names with spaces} -constraints {win reg} -set registry delete HKEY_CURRENT_USER\\TclFoobar } -result {{baz bar} blat} -test registry-8.1 {OpenSubKey} -constraints {win reg english} \ +test registry-8.1 {OpenSubKey} -constraints {win reg nonPortable english} \ -body { # This test will only succeed if the current user does not have # registry access on the specified machine. @@ -657,7 +657,7 @@ test registry-11.2 {SetValue: modification} -constraints {win reg} \ set result [registry get HKEY_CURRENT_USER\\TclFoobar\\baz blat] } -result {frob} test registry-11.3 {SetValue: failure} \ - -constraints {win reg english} \ + -constraints {win reg nonPortable english} \ -body { # This test will only succeed if the current user does not have # registry access on the specified machine. |