merge changes from trunknovem_no_startcmd

13 files changed, 57 insertions, 47 deletions

diff --git a/tests/chan.test b/tests/chan.test
index da44ffd..d8390e2 100644
--- a/tests/chan.test
+++ b/tests/chan.test
@@ -61,7 +61,7 @@ test chan-4.5 {chan command: check valid inValue, invalid outValue} -body {
 } -returnCodes error -match glob -result {bad value for -eofchar:*}
 test chan-4.6 {chan command: check no inValue, valid outValue} -body {
     chan configure stdout -eofchar [list {} \x27]
-} -returnCodes ok -result {}
+} -returnCodes ok -result {} -cleanup {chan configure stdout -eofchar [list {} {}]}
 
 test chan-5.1 {chan command: copy subcommand} -body {
     chan copy foo
diff --git a/tests/cmdAH.test b/tests/cmdAH.test
index 3011597..0517e5f 100644
--- a/tests/cmdAH.test
+++ b/tests/cmdAH.test
@@ -68,6 +68,12 @@ test cmdAH-1.2 {Tcl_CatchObjCmd, errors} {
 test cmdAH-1.3 {Tcl_CatchObjCmd, errors} -returnCodes error -body {
     catch foo bar baz spaz
 } -result {wrong # args: should be "catch script ?resultVarName? ?optionVarName?"}
+test cmdAH-1.4 {Bug 3595576} {
+    catch {catch {} -> noSuchNs::var}
+} 1
+test cmdAH-1.5 {Bug 3595576} {
+    catch {catch error -> noSuchNs::var}
+} 1
 
 test cmdAH-2.1 {Tcl_CdObjCmd} -returnCodes error -body {
     cd foo bar
diff --git a/tests/env.test b/tests/env.test
index 9010f52..e75d517 100644
--- a/tests/env.test
+++ b/tests/env.test
@@ -70,7 +70,7 @@ set printenvScript [makeFile {
     }
     proc mangle s {
 	regsub -all {\[|\\|\]} $s {\\&} s
-	regsub -all {[\u0000-\u001f\u007f-\uffff]} $s {[manglechar &]} s
+	regsub -all "\[\u0000-\u001f\u007f-\uffff\]" $s {[manglechar &]} s
 	return [subst -novariables $s]
     }
     proc manglechar c {
diff --git a/tests/exec.test b/tests/exec.test
index 64d3517..871c0c5 100644
--- a/tests/exec.test
+++ b/tests/exec.test
@@ -157,7 +157,7 @@ test exec-2.6 {redirecting input from immediate source, with UTF} -setup {
     encoding system iso8859-1
     proc quotenonascii s {
 	regsub -all {\[|\\|\]} $s {\\&} s
-	regsub -all {[\u007f-\uffff]} $s \
+	regsub -all "\[\u007f-\uffff\]" $s \
 	    {[apply {c {format {\u%04x} [scan $c %c]}} &]} s
 	return [subst -novariables $s]
     }
diff --git a/tests/http.test b/tests/http.test
index 9861e0e..e2de7d8 100644
--- a/tests/http.test
+++ b/tests/http.test
@@ -547,11 +547,10 @@ test http-4.14 {http::Event} -body {
 	error "bogus return from http::geturl"
     }
     http::wait $token
-    http::status $token
-    # error code varies among platforms.
-} -returnCodes 1 -match regexp -cleanup {
+    lindex [http::error $token] 0
+} -cleanup {
     catch {http::cleanup $token}
-} -result {(connect failed|couldn't open socket)}
+} -result {connect failed connection refused}
 # Bogus host
 test http-4.15 {http::Event} -body {
     # This test may fail if you use a proxy server. That is to be
diff --git a/tests/info.test b/tests/info.test
index 5078e11..ebc853a 100644
--- a/tests/info.test
+++ b/tests/info.test
@@ -692,31 +692,31 @@ test info-21.5 {miscellaneous error conditions} -returnCodes error -body {
 ##
 # ### ### ### ######### ######### #########
 ## info frame
+
 ## Helper
 # For the more complex results we cut the file name down to remove path
 # dependencies, and we use only part of the first line of the reported
 # command. The latter is required because otherwise the whole test case may
 # appear in some results, but the result is part of the testcase. An infinite
 # string would be required to describe that. The cutting-down breaks this.
+
 proc reduce {frame} {
-    set  pos [lsearch -exact $frame cmd]
-    incr pos
-    set  cmd [lindex $frame $pos]
+    set cmd [dict get $frame cmd]
     if {[regexp \n $cmd]} {
-	set first [string range [lindex [split $cmd \n] 0] 0 end-4]
-	set frame [lreplace $frame $pos $pos $first]
+	dict set frame cmd \
+	    [string range [lindex [split $cmd \n] 0] 0 end-4]
     }
-    set pos [lsearch -exact $frame file]
-    if {$pos >=0} {
-	incr pos
-	set tail  [file tail [lindex $frame $pos]]
-	set frame [lreplace $frame $pos $pos $tail]
+    if {[dict exists $frame file]} {
+	dict set frame file \
+	    [file tail [dict get $frame file]]
     }
-    set frame
+    return $frame
 }
+
 proc subinterp {} { interp create sub ; interp debug sub -frame 1;
     interp eval sub [list proc reduce [info args reduce] [info body reduce]]
 }
+
 ## Helper
 # Generate a stacktrace from the current location to top.  This code
 # not only depends on the exact location of things, but also on the
@@ -1454,9 +1454,9 @@ test info-30.1 {bs+nl in literal words, procedure body, compiled} -body {
 test info-30.2 {bs+nl in literal words, namespace script} {
     namespace eval xxx {
 	variable res \
-	    [reduce [info frame 0]];# line 1457
+	    [info frame 0];# line 1457
     }
-    return $xxx::res
+    return [reduce $xxx::res]
 } {type source line 1457 file info.test cmd {info frame 0} level 0}
 
 test info-30.3 {bs+nl in literal words, namespace multi-word script} {
diff --git a/tests/listObj.test b/tests/listObj.test
index 8b24aa9..937fb1d 100644
--- a/tests/listObj.test
+++ b/tests/listObj.test
@@ -196,6 +196,10 @@ test listobj-10.1 {Bug [2971669]} {*}{
     -result {{a b c d e} {} {a b c d e f}}
 }
 
+test listobj-11.1 {bug 3598580} {
+    testobj bug3598580
+} 123
+
 # cleanup
 ::tcltest::cleanupTests
 return
diff --git a/tests/load.test b/tests/load.test
index eef677f..cded85d 100644
--- a/tests/load.test
+++ b/tests/load.test
@@ -188,7 +188,7 @@ test load-8.3 {TclGetLoadedPackages procedure} [list teststaticpkg $dll $loaded]
 test load-8.4 {TclGetLoadedPackages procedure} [list $dll $loaded teststaticpkg] {
     load [file join $testDir pkgb$ext] pkgb
     list [info loaded {}] [lsort [info commands pkgb_*]]
-} [list [concat [list [list [file join $testDir pkgb$ext] Pkgb] {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkga$ext] Pkga]] $alreadyLoaded] {pkgb_sub pkgb_unsafe}]
+} [list [concat [list [list [file join $testDir pkgb$ext] Pkgb] {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkga$ext] Pkga]] $alreadyLoaded] {pkgb_demo pkgb_sub pkgb_unsafe}]
 interp delete child
 
 test load-9.1 {Tcl_StaticPackage, load already-loaded package into another interp} \
diff --git a/tests/nre.test b/tests/nre.test
index b8ef2e0..b5eb032 100644
--- a/tests/nre.test
+++ b/tests/nre.test
@@ -74,7 +74,6 @@ test nre-1.1 {self-recursive procs} -setup {
 } -constraints {
     testnrelevels
 } -result {{0 1 1 1} 0}
-
 test nre-1.2 {self-recursive lambdas} -setup {
     set a [list i [makebody {apply $::a $i}]]
 } -body {
@@ -85,7 +84,6 @@ test nre-1.2 {self-recursive lambdas} -setup {
 } -constraints {
     testnrelevels
 } -result {{0 1 1 1} 0}
-
 test nre-1.3 {mutually recursive procs and lambdas} -setup {
     proc a i {
 	apply $::b [incr i]
@@ -164,8 +162,7 @@ test nre-5.1 {[namespace eval] is not recursive} -setup {
     namespace delete ::foo
 } -constraints {
     testnrelevels
-} -result {{0 3 2 2} 0}
-
+} -result {{0 2 2 2} 0}
 test nre-5.2 {[namespace eval] is not recursive} -setup {
     namespace eval ::foo {
 	setabs
@@ -177,7 +174,7 @@ test nre-5.2 {[namespace eval] is not recursive} -setup {
     namespace delete ::foo
 } -constraints {
     testnrelevels
-} -result {{0 3 2 2} 0}
+} -result {{0 2 2 2} 0}
 
 test nre-6.1 {[uplevel] is not recursive} -setup {
     proc a i [makebody {uplevel 1 [list a $i]}]
@@ -189,7 +186,6 @@ test nre-6.1 {[uplevel] is not recursive} -setup {
 } -constraints {
     testnrelevels
 } -result {{0 2 2 0} 0}
-
 test nre-6.2 {[uplevel] is not recursive} -setup {
     setabs
     proc a i [makebody {uplevel 1 "set x $i; a $i"}]
@@ -211,7 +207,6 @@ test nre-7.1 {[catch] is not recursive} -setup {
 } -constraints {
     testnrelevels
 } -result {{0 3 3 0} 0}
-
 test nre-7.2 {[if] is not recursive} -setup {
     setabs
     proc a i [makebody {uplevel 1 "if 1 {a $i}"}]
@@ -222,7 +217,6 @@ test nre-7.2 {[if] is not recursive} -setup {
 } -constraints {
     testnrelevels
 } -result {{0 2 2 0} 0}
-
 test nre-7.3 {[while] is not recursive} -setup {
     setabs
     proc a i [makebody {uplevel 1 "while 1 {set res \[a $i\]; break}; set res"}]
@@ -233,7 +227,6 @@ test nre-7.3 {[while] is not recursive} -setup {
 } -constraints {
     testnrelevels
 } -result {{0 2 2 0} 0}
-
 test nre-7.4 {[for] is not recursive} -setup {
     setabs
     proc a i [makebody {uplevel 1 "for {set j 0} {\$j < 10} {incr j} {set res \[a $i\]; break}; set res"}]
@@ -244,7 +237,6 @@ test nre-7.4 {[for] is not recursive} -setup {
 } -constraints {
     testnrelevels
 } -result {{0 2 2 0} 0}
-
 test nre-7.5 {[foreach] is not recursive} -setup {
     #
     # Enable once [foreach] is NR-enabled
@@ -258,7 +250,6 @@ test nre-7.5 {[foreach] is not recursive} -setup {
 } -constraints {
     testnrelevels
 } -result {{0 3 3 0} 0}
-
 test nre-7.6 {[eval] is not recursive} -setup {
     proc a i [makebody {eval [list a $i]}]
 } -body {
@@ -269,7 +260,6 @@ test nre-7.6 {[eval] is not recursive} -setup {
 } -constraints {
     testnrelevels
 } -result {{0 2 2 1} 0}
-
 test nre-7.7 {[eval] is not recursive} -setup {
     proc a i [makebody {eval "a $i"}]
 } -body {
@@ -280,7 +270,6 @@ test nre-7.7 {[eval] is not recursive} -setup {
 } -constraints {
     testnrelevels
 } -result {{0 2 2 1} 0}
-
 test nre-7.8 {bug #2910748: switch out of stale BC is not nre-aware} -setup {
     proc foo args {}
     foo
@@ -295,18 +284,15 @@ test nre-7.8 {bug #2910748: switch out of stale BC is not nre-aware} -setup {
 } -body {
     # if switching to plain eval is not nre aware, this will cause a "cannot
     # yield" error
-
     list [bar] [bar] [bar]
 } -cleanup {
     rename bar {}
     rename foo {}
 } -result {1 2 3}
 
-
 test nre-8.1 {nre and {*}} -body {
     # force an expansion that grows the evaluation stack, check that nre
     # adapts the TEBCdataPtr. This crashes on failure.
-
     proc inner {} {
 	set long [lrepeat 1000000 1]
 	list {*}$long
@@ -321,21 +307,18 @@ test nre-8.2 {nre and {*}, [Bug 2415422]} -body {
     # force an expansion that grows the evaluation stack, check that nre
     # adapts the bcFramePtr. This causes an NRE assertion to fail if it is not
     # done properly.
-
     proc nop {} {}
     proc crash {} {
 	foreach val [list {*}[lrepeat 100000 x]] {
 	    nop
 	}
     }
-
     crash
 } -cleanup {
     rename nop {}
     rename crash {}
 }
 
-
 #
 #  Basic TclOO tests
 #
@@ -351,7 +334,6 @@ test nre-oo.1 {really deep calls in oo - direct} -setup {
 } -constraints {
     testnrelevels
 } -result {{0 1 1 1} 0}
-
 test nre-oo.2 {really deep calls in oo - call via [self]} -setup {
     oo::object create foo
     oo::objdefine foo method bar i [makebody {[self] bar $i}]
@@ -363,7 +345,6 @@ test nre-oo.2 {really deep calls in oo - call via [self]} -setup {
 } -constraints {
     testnrelevels
 } -result {{0 1 1 1} 0}
-
 test nre-oo.3 {really deep calls in oo - private calls} -setup {
     oo::object create foo
     oo::objdefine foo method bar i [makebody {my bar $i}]
@@ -375,7 +356,6 @@ test nre-oo.3 {really deep calls in oo - private calls} -setup {
 } -constraints {
     testnrelevels
 } -result {{0 1 1 1} 0}
-
 test nre-oo.4 {really deep calls in oo - overriding} -setup {
     oo::class create foo {
 	method bar i [makebody {my bar $i}]
@@ -392,7 +372,6 @@ test nre-oo.4 {really deep calls in oo - overriding} -setup {
 } -constraints {
     testnrelevels
 } -result {{0 1 1 1} 0}
-
 test nre-oo.5 {really deep calls in oo - forwards} -setup {
     oo::object create foo
     set body [makebody {my boo $i}]
@@ -409,7 +388,6 @@ test nre-oo.5 {really deep calls in oo - forwards} -setup {
     testnrelevels
 } -result {{0 2 1 1} 0}
 
-
 #
 # NASTY BUG found by tcllib's interp package
 #
diff --git a/tests/oo.test b/tests/oo.test
index 540cdf3..5d34077 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -7,7 +7,7 @@
 # See the file "license.terms" for information on usage and redistribution of
 # this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
-package require -exact TclOO 0.7 ;# Must match value in generic/tclOO.h
+package require TclOO 1.0
 package require tcltest 2
 if {"::tcltest" in [namespace children]} {
     namespace import -force ::tcltest::*
diff --git a/tests/ooNext2.test b/tests/ooNext2.test
index e78e0d0..d77e8d1 100644
--- a/tests/ooNext2.test
+++ b/tests/ooNext2.test
@@ -7,7 +7,7 @@
 # See the file "license.terms" for information on usage and redistribution of
 # this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
-package require -exact TclOO 0.7 ;# Must match value in configure.in
+package require TclOO 1.0
 package require tcltest 2
 if {"::tcltest" in [namespace children]} {
     namespace import -force ::tcltest::*
diff --git a/tests/parse.test b/tests/parse.test
index 0f76d64..bc4107d 100644
--- a/tests/parse.test
+++ b/tests/parse.test
@@ -26,6 +26,7 @@ testConstraint testparsevarname [llength [info commands testparsevarname]]
 testConstraint testparsevar [llength [info commands testparsevar]]
 testConstraint testasync [llength [info commands testasync]]
 testConstraint testcmdtrace [llength [info commands testcmdtrace]]
+testConstraint testevent [llength [info commands testevent]]
 
 test parse-1.1 {Tcl_ParseCommand procedure, computing string length} testparser {
     testparser [bytestring "foo\0 bar"] -1
@@ -1090,6 +1091,14 @@ test parse-20.12 {TclParseBackslash: truncated escape} testparser {
     testparser {\x12X} 5
 } {- {\x12X} 1 word {\x12X} 2 backslash {\x12} 0 text X 0 {}}
 
+test parse-21.0 {Bug 1884496} testevent {
+    set ::script {set a [p]; return -level 0 $a}
+    proc ::p {} {string first s $::script}
+    testevent queue a head $::script
+    update
+} {}
+
+
 cleanupTests
 }
 
diff --git a/tests/zlib.test b/tests/zlib.test
index 5f1e5fc..891dba0 100644
--- a/tests/zlib.test
+++ b/tests/zlib.test
@@ -826,6 +826,20 @@ test zlib-11.2 "Bug #3390073: mis-appled gzip filtering" -setup {
 } -cleanup {
     removeFile $file
 } -result {1000 /foo/bar 0}
+test zlib-11.3 {Bug 3595576 variant} -setup {
+    set file [makeFile {} test.input]
+} -constraints zlib -body {
+    set f [open $file wb]
+    puts -nonewline [zlib push gzip $f -header {filename /foo/bar}] \
+	[string repeat "hello" 1000]
+    close $f
+    set f [open $file rb]
+    set d [read $f]
+    close $f
+    zlib gunzip $d -header noSuchNs::foo
+} -cleanup {
+    removeFile $file
+} -returnCodes error -result {can't set "noSuchNs::foo": parent namespace doesn't exist}
 
 ::tcltest::cleanupTests
 return