merge 8.6

4 files changed, 115 insertions, 61 deletions

diff --git a/tests/parseOld.test b/tests/parseOld.test
index a6e07a2..504d063 100644
--- a/tests/parseOld.test
+++ b/tests/parseOld.test
@@ -13,7 +13,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
-package require tcltest
+package require tcltest 2
 namespace import ::tcltest::*
 
 ::tcltest::loadTestedCommands
@@ -37,7 +37,7 @@ proc getArgs args {
     global argv
     set argv $args
 }
-
+
 # Basic argument parsing.
 
 test parseOld-1.1 {basic argument parsing} {
@@ -296,6 +296,7 @@ test parseOld-8.4 {semi-colons} {
 # The following checks are to ensure that the interpreter's result
 # gets re-initialized by Tcl_Eval in all the right places.
 
+set a 22
 test parseOld-9.1 {result initialization} {concat abc} abc
 test parseOld-9.2 {result initialization} {concat abc; proc foo {} {}} {}
 test parseOld-9.3 {result initialization} {concat abc; proc foo {} $a} {}
@@ -408,6 +409,8 @@ test parseOld-11.7 {long values} {
     set b [concat 1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG HHHH]
     llength $b
 } 43
+# Duplicate action of previous test
+llength [set b [concat 1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG HHHH]]
 test parseOld-11.8 {long values} {
     set b
 } $a
@@ -538,8 +541,12 @@ test parseOld-15.4 {TclScriptEnd procedure} {
 test parseOld-15.5 {TclScriptEnd procedure} {
     info complete "xyz \[abc"
 } {0}
-
+
 # cleanup
 set argv $savedArgv
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/set-old.test b/tests/set-old.test
index 0e9ca63..93169f1 100644
--- a/tests/set-old.test
+++ b/tests/set-old.test
@@ -14,7 +14,7 @@
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
-    package require tcltest
+    package require tcltest 2
     namespace import -force ::tcltest::*
 }
 
@@ -865,6 +865,8 @@ test set-old-10.13 {array enumeration errors} {
     list [catch {array done a b c} msg] $msg
 } {1 {wrong # args: should be "array donesearch arrayName searchId"}}
 test set-old-10.14 {array enumeration errors} {
+    catch {unset a}
+    set a(a) a
     list [catch {array done a b} msg] $msg
 } {1 {illegal search identifier "b"}}
 test set-old-10.15 {array enumeration errors} {
diff --git a/tests/set.test b/tests/set.test
index 7e4b864..3c87000 100644
--- a/tests/set.test
+++ b/tests/set.test
@@ -22,7 +22,7 @@ testConstraint testset2 [llength [info commands testset2]]
 
 catch {unset x}
 catch {unset i}
-
+
 test set-1.1 {TclCompileSetCmd: missing variable name} {
     list [catch {set} msg] $msg
 } {1 {wrong # args: should be "set varName ?newValue?"}}
@@ -39,16 +39,18 @@ test set-1.4 {TclCompileSetCmd: simple variable name in quotes} {
     set i 17
     list [set "i"] $i
 } {17 17}
-test set-1.5 {TclCompileSetCmd: simple variable name in braces} {
+test set-1.5 {TclCompileSetCmd: simple variable name in braces} -setup {
     catch {unset {a simple var}}
+} -body {
     set {a simple var} 27
     list [set {a simple var}] ${a simple var}
-} {27 27}
-test set-1.6 {TclCompileSetCmd: simple array variable name} {
+} -result {27 27}
+test set-1.6 {TclCompileSetCmd: simple array variable name} -setup {
     catch {unset a}
+} -body {
     set a(foo) 37
     list [set a(foo)] $a(foo)
-} {37 37}
+} -result {37 37}
 test set-1.7 {TclCompileSetCmd: non-simple (computed) variable name} {
     set x "i"
     set i 77
@@ -149,22 +151,24 @@ test set-1.14 {TclCompileSetCmd: simple local name, >255 locals} {
     }
     260locals
 } {1234}
-test set-1.15 {TclCompileSetCmd: variable is array} {
+test set-1.15 {TclCompileSetCmd: variable is array} -setup {
     catch {unset a}
+} -body {
     set x 27
     set x [set a(foo) 11]
     catch {unset a}
     set x
-} 11
-test set-1.16 {TclCompileSetCmd: variable is array, elem substitutions} {
+} -result 11
+test set-1.16 {TclCompileSetCmd: variable is array, elem substitutions} -setup {
     catch {unset a}
+} -body {
     set i 5
     set x 789
     set a(foo5) 27
     set x [set a(foo$i)]
     catch {unset a}
     set x
-} 27
+} -result 27
 
 test set-1.17 {TclCompileSetCmd: doing assignment, simple int} {
     set i 5
@@ -211,7 +215,7 @@ test set-1.25 {TclCompileSetCmd: var is array, braced (no subs)} {
 test set-1.26 {TclCompileSetCmd: various array constructs} {
     # Test all kinds of array constructs that TclCompileSetCmd
     # may feel inclined to tamper with.
-    proc p {} {
+    apply {{} {
 	set a x
 	set be(hej) 1					; # hej
 	set be($a) 1					; # x
@@ -230,28 +234,33 @@ test set-1.26 {TclCompileSetCmd: various array constructs} {
 	set [string range bet 0 1](foo) 1		; # foo
 	set be([set be(a:$a)][set b\e($a)]) 1		; # 51
 	return [lsort [array names be]]
-    }
-    p
+    }}
 } [lsort {hej x $a x,hej x,x c(x ww a:x hej,1,hej hug {a a} {x ,ugg,hej} x,h"ej
 {b c} foo 51}]; # " just a matching end quote
 
-test set-2.1 {set command: runtime error, bad variable name} {
+test set-2.1 {set command: runtime error, bad variable name} -setup {
     unset -nocomplain {"foo}
+} -body {
     list [catch {set {"foo}} msg] $msg $::errorInfo
-} {1 {can't read ""foo": no such variable} {can't read ""foo": no such variable
+} -result {1 {can't read ""foo": no such variable} {can't read ""foo": no such variable
     while executing
 "set {"foo}"}}
-test set-2.2 {set command: runtime error, not array variable} {
-    catch {unset b}
+# Stop my editor highlighter " from being confused
+test set-2.2 {set command: runtime error, not array variable} -setup {
+    unset -nocomplain b
+} -body {
     set b 44
     list [catch {set b(123)} msg] $msg
-} {1 {can't read "b(123)": variable isn't array}}
-test set-2.3 {set command: runtime error, errors in reading variables} {
-    catch {unset a}
+} -result {1 {can't read "b(123)": variable isn't array}}
+test set-2.3 {set command: runtime error, errors in reading variables} -setup {
+    unset -nocomplain a
+} -body {
     set a(6) 44
     list [catch {set a(18)} msg] $msg
-} {1 {can't read "a(18)": no such element in array}}
-test set-2.4 {set command: runtime error, readonly variable} -body {
+} -result {1 {can't read "a(18)": no such element in array}}
+test set-2.4 {set command: runtime error, readonly variable} -setup {
+    unset -nocomplain x
+} -body {
     proc readonly args {error "variable is read-only"}
     set x 123
     trace var x w readonly
@@ -260,12 +269,18 @@ test set-2.4 {set command: runtime error, readonly variable} -body {
     while executing
 *
 "set x 1"}}
-test set-2.5 {set command: runtime error, basic array operations} {
+test set-2.5 {set command: runtime error, basic array operations} -setup {
+    unset -nocomplain a
+} -body {
+    array set a {}
     list [catch {set a(other)} msg] $msg
-} {1 {can't read "a(other)": no such element in array}}
-test set-2.6 {set command: runtime error, basic array operations} {
+} -result {1 {can't read "a(other)": no such element in array}}
+test set-2.6 {set command: runtime error, basic array operations} -setup {
+    unset -nocomplain a
+} -body {
+    array set a {}
     list [catch {set a} msg] $msg
-} {1 {can't read "a": variable is array}}
+} -result {1 {can't read "a": variable is array}}
 
 # Test the uncompiled version of set
 
@@ -479,25 +494,29 @@ test set-3.24 {uncompiled set command: too many arguments} {
     $z msg
 } {wrong # args: should be "set varName ?newValue?"}
 
-test set-4.1 {uncompiled set command: runtime error, bad variable name} {
+test set-4.1 {uncompiled set command: runtime error, bad variable name} -setup {
     unset -nocomplain {"foo}
+} -body {
     set z set
     list [catch {$z {"foo}} msg] $msg $::errorInfo
-} {1 {can't read ""foo": no such variable} {can't read ""foo": no such variable
+} -result {1 {can't read ""foo": no such variable} {can't read ""foo": no such variable
     while executing
 "$z {"foo}"}}
-test set-4.2 {uncompiled set command: runtime error, not array variable} {
-    set z set
+# Stop my editor highlighter " from being confused
+test set-4.2 {uncompiled set command: runtime error, not array variable} -setup {
     catch {unset b}
+} -body {
+    set z set
     $z b 44
     list [catch {$z b(123)} msg] $msg
-} {1 {can't read "b(123)": variable isn't array}}
-test set-4.3 {uncompiled set command: runtime error, errors in reading variables} {
-     set z set
-   catch {unset a}
+} -result {1 {can't read "b(123)": variable isn't array}}
+test set-4.3 {uncompiled set command: runtime error, errors in reading variables} -setup {
+    catch {unset a}
+} -body {
+    set z set
     $z a(6) 44
     list [catch {$z a(18)} msg] $msg
-} {1 {can't read "a(18)": no such element in array}}
+} -result {1 {can't read "a(18)": no such element in array}}
 test set-4.4 {uncompiled set command: runtime error, readonly variable} -body {
     set z set
     proc readonly args {error "variable is read-only"}
@@ -508,27 +527,33 @@ test set-4.4 {uncompiled set command: runtime error, readonly variable} -body {
     while executing
 *
 "$z x 1"}}
-test set-4.5 {uncompiled set command: runtime error, basic array operations} {
+test set-4.5 {uncompiled set command: runtime error, basic array operations} -setup {
+    unset -nocomplain a
+    array set a {}
+} -body {
     set z set
     list [catch {$z a(other)} msg] $msg
-} {1 {can't read "a(other)": no such element in array}}
-test set-4.6 {set command: runtime error, basic array operations} {
+} -result {1 {can't read "a(other)": no such element in array}}
+test set-4.6 {set command: runtime error, basic array operations} -setup {
+    unset -nocomplain a
+    array set a {}
+} -body {
     set z set
     list [catch {$z a} msg] $msg
-} {1 {can't read "a": variable is array}}
+} -result {1 {can't read "a": variable is array}}
 
-test set-5.1 {error on malformed array name} testset2 {
+test set-5.1 {error on malformed array name} -constraints testset2 -setup {
     unset -nocomplain z
+} -body {
     catch {testset2 z(a) b} msg
     catch {testset2 z(b) a} msg1
     list $msg $msg1
-} {{can't read "z(a)(b)": variable isn't array} {can't read "z(b)(a)": variable isn't array}}
-
+} -result {{can't read "z(a)(b)": variable isn't array} {can't read "z(b)(a)": variable isn't array}}
 # In a mem-debug build, this test will crash unless Bug 3602706 is fixed.
 test set-5.2 {Bug 3602706} -body {
     testset2 ::tcl_platform not-in-there
 } -returnCodes error -result * -match glob
-
+
 # cleanup
 catch {unset a}
 catch {unset b}
@@ -537,3 +562,7 @@ catch {unset x}
 catch {unset z}
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/var.test b/tests/var.test
index 6f90664..e223f6e 100644
--- a/tests/var.test
+++ b/tests/var.test
@@ -44,10 +44,12 @@ test var-1.1 {TclLookupVar, Array handling} -setup {
     set arr(foo) 37
     list [$x i] $i [$x arr(foo)] $arr(foo)
 } -result {11 11 38 38}
+set ::x "global value"
+namespace eval test_ns_var {
+    variable x "namespace value"
+}
 test var-1.2 {TclLookupVar, TCL_GLOBAL_ONLY implies global namespace var} {
-    set x "global value"
     namespace eval test_ns_var {
-        variable x "namespace value"
         proc p {} {
             global x  ;# specifies TCL_GLOBAL_ONLY to get global x
             return $x
@@ -261,6 +263,7 @@ test var-3.7 {MakeUpvar, my var has ::s} -setup {
     }
 } -result {789789}
 test var-3.8 {MakeUpvar, my var already exists in global ns} -setup {
+    upvar #0 aaaaa xxxxx
     catch {unset aaaaa}
     catch {unset xxxxx}
 } -body {
@@ -274,6 +277,8 @@ test var-3.9 {MakeUpvar, my var has invalid ns name} -setup {
 } -returnCodes error -body {
     set aaaaa 789789
     upvar #0 aaaaa test_ns_fred::lnk
+} -cleanup {
+    unset ::aaaaa
 } -result {can't create "test_ns_fred::lnk": parent namespace doesn't exist}
 test var-3.10 {MakeUpvar, between namespaces} -body {
     namespace eval {} {
@@ -282,8 +287,6 @@ test var-3.10 {MakeUpvar, between namespaces} -body {
 	set foo::bar 1
 	list $bar $foo::bar
     }
-} -cleanup {
-    unset ::aaaaa
 } -result {1 1}
 test var-3.11 {MakeUpvar, my var looks like array elem} -setup {
     catch {unset aaaaa}
@@ -322,9 +325,11 @@ test var-5.2 {Tcl_GetVariableFullName, namespace variable} {
         namespace which -variable martha
     }
 } {::test_ns_var::martha}
-test var-5.3 {Tcl_GetVariableFullName, namespace variable} {
+test var-5.3 {Tcl_GetVariableFullName, namespace variable} -setup {
+    namespace eval test_ns_var {variable martha}
+} -body {
     namespace which -variable test_ns_var::martha
-} {::test_ns_var::martha}
+} -result {::test_ns_var::martha}
 
 test var-6.1 {Tcl_GlobalObjCmd, variable is qualified by a namespace name} {
     namespace eval test_ns_var {
@@ -348,6 +353,7 @@ test var-6.2 {Tcl_GlobalObjCmd, variable is qualified by a namespace name} {
     test_ns_var::p
 } {java}
 test var-6.3 {Tcl_GlobalObjCmd, variable named {} qualified by a namespace name} {
+    namespace eval ::test_ns_var::test_ns_nested {}
     set ::test_ns_var::test_ns_nested:: 24
     apply {{} {
         global ::test_ns_var::test_ns_nested::
@@ -389,20 +395,26 @@ test var-7.2 {Tcl_VariableObjCmd, if new and no value, leave undefined} {
     }
     list [info exists test_ns_var::two] [catch {set test_ns_var::two} msg] $msg
 } {0 1 {can't read "test_ns_var::two": no such variable}}
-test var-7.3 {Tcl_VariableObjCmd, "define" var already created above} {
+test var-7.3 {Tcl_VariableObjCmd, "define" var already created above} -setup {
+    catch {namespace delete test_ns_var}
+    namespace eval test_ns_var {variable one 1}
+} -body {
     namespace eval test_ns_var {
         variable two 2
     }
     list [lsort [info vars test_ns_var::*]] \
          [namespace eval test_ns_var {set two}]
-} [list [lsort {::test_ns_var::two ::test_ns_var::one}] 2]
-test var-7.4 {Tcl_VariableObjCmd, list of vars} {
+} -result [list [lsort {::test_ns_var::two ::test_ns_var::one}] 2]
+test var-7.4 {Tcl_VariableObjCmd, list of vars} -setup {
+    catch {namespace delete test_ns_var}
+    namespace eval test_ns_var {variable one 1; variable two 2}
+} -body {
     namespace eval test_ns_var {
         variable three 3 four 4
     }
     list [lsort [info vars test_ns_var::*]] \
          [namespace eval test_ns_var {expr $three+$four}]
-} [list [lsort {::test_ns_var::four ::test_ns_var::three ::test_ns_var::two ::test_ns_var::one}] 7]
+} -result [list [lsort {::test_ns_var::four ::test_ns_var::three ::test_ns_var::two ::test_ns_var::one}] 7]
 test var-7.5 {Tcl_VariableObjCmd, value for last var is optional} -setup {
     catch {unset a}
     catch {unset five}
@@ -476,7 +488,9 @@ test var-7.9 {Tcl_VariableObjCmd, mark as namespace var so var persists until na
 	[lsort {::test_ns_var2::x ::test_ns_var2::z}] 0 0\
 	{1 {can't unset "test_ns_var2::z": no such variable}}\
 	{}]
-test var-7.10 {Tcl_VariableObjCmd, variable cmd inside proc creates local link var} {
+test var-7.10 {Tcl_VariableObjCmd, variable cmd inside proc creates local link var} -setup {
+    namespace eval test_ns_var { variable eight 8 }
+} -body {
     namespace eval test_ns_var {
         proc p {} {
             variable eight
@@ -484,14 +498,16 @@ test var-7.10 {Tcl_VariableObjCmd, variable cmd inside proc creates local link v
         }
         p
     }
-} {8 eight}
-test var-7.11 {Tcl_VariableObjCmd, variable cmd inside proc creates local link var} {
+} -result {8 eight}
+test var-7.11 {Tcl_VariableObjCmd, variable cmd inside proc creates local link var} -setup {
+    namespace eval test_ns_var { variable eight 8 }
+} -body {
     proc p {} {   ;# note this proc is at global :: scope
         variable test_ns_var::eight
         list [set eight] [info vars]
     }
     p
-} {8 eight}
+} -result {8 eight}
 test var-7.12 {Tcl_VariableObjCmd, variable cmd inside proc creates local link var} {
     namespace eval test_ns_var {
         variable {} {My name is empty}
@@ -774,7 +790,7 @@ test var-17.1 {TclArraySet [Bug 1669489]} -setup {
 
 test var-18.1 {array unset and unset traces: Bug 2939073} -setup {
     set already 0
-    unset x
+    unset -nocomplain x
 } -body {
     array set x {e 1 i 1}
     trace add variable x unset {apply {args {