From e11daf6fb666f377464fdedddde9126ba31658d7 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Sun, 26 Jun 2016 09:01:26 +0000
Subject: (cherry-pick) [c30087b04f] Install man pages with permissions 644
 instead of 444.

---
 unix/installManPage | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/unix/installManPage b/unix/installManPage
index 6bdccf0..1dbd232 100755
--- a/unix/installManPage
+++ b/unix/installManPage
@@ -105,7 +105,7 @@ for Target in $Names; do
 	First=$Target
 	sed -e "/man\.macros/r $SrcDir/man.macros" -e "/man\.macros/d" \
 	    $ManPage > $Dir/$First
-	chmod 444 $Dir/$First
+	chmod 644 $Dir/$First
 	$Gzip $Dir/$First
     else
 	ln $SymOrLoc$First$Gz $Dir/$Target$Gz
-- 
cgit v0.12


From 8f0cfce66a4fd94536faac0595c3d7d7c7844d64 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Fri, 8 Jul 2016 12:38:35 +0000
Subject: (cherry-pick): Bugfix [5d7ea04580]. Treat .cmd and .ps1 files are
 executable on Windows.

---
 doc/file.n       | 4 +++-
 win/tclWinFile.c | 4 +++-
 2 files changed, 6 insertions(+), 2 deletions(-)

diff --git a/doc/file.n b/doc/file.n
index 36eae79..43eae7a 100644
--- a/doc/file.n
+++ b/doc/file.n
@@ -156,7 +156,9 @@ returns \fB/home\fR (or something similar).
 \fBfile executable \fIname\fR
 .
 Returns \fB1\fR if file \fIname\fR is executable by the current user,
-\fB0\fR otherwise.  
+\fB0\fR otherwise. On Windows, which does not have an executable attribute,
+the command treats all directories and any files with extensions
+\fBexe\fR, \fBcom\fR, \fBcmd\fR, \fBbat\fR or \fBps1\fR as executable.
 .TP
 \fBfile exists \fIname\fR
 .
diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index 41de4a8..e671058 100755
--- a/win/tclWinFile.c
+++ b/win/tclWinFile.c
@@ -1783,7 +1783,7 @@ NativeAccess(
  * NativeIsExec --
  *
  *	Determines if a path is executable. On windows this is simply defined
- *	by whether the path ends in any of ".exe", ".com", or ".bat"
+ *	by whether the path ends in a standard executable extension.
  *
  * Results:
  *	1 = executable, 0 = not.
@@ -1834,6 +1834,8 @@ NativeIsExec(
 
 	    if ((strcasecmp(p, "exe") == 0)
 		    || (strcasecmp(p, "com") == 0)
+		    || (strcasecmp(p, "cmd") == 0)
+		    || (strcasecmp(p, "ps1") == 0)
 		    || (strcasecmp(p, "bat") == 0)) {
 		/*
 		 * File that ends with .exe, .com, or .bat is executable.
-- 
cgit v0.12


From c65f04435b80a065f992d534fcd8bfc9a5a0e8ef Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Thu, 14 Jul 2016 08:31:00 +0000
Subject: [77d58e3a7a] Test case independence: chanio, cmdah, env, history.

---
 tests/chanio.test  | 23 +++++++++++++++++++----
 tests/cmdAH.test   |  8 ++++++--
 tests/env.test     | 12 ++++++++++--
 tests/history.test |  5 +++++
 4 files changed, 40 insertions(+), 8 deletions(-)

diff --git a/tests/chanio.test b/tests/chanio.test
index 2738fc6..29f42c3 100644
--- a/tests/chanio.test
+++ b/tests/chanio.test
@@ -4160,12 +4160,20 @@ test chan-io-33.4 {Tcl_Gets with long line} -setup {
 } -cleanup {
     chan close $f
 } -result {abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ}
-test chan-io-33.5 {Tcl_Gets with long line} {
+test chan-io-33.5 {Tcl_Gets with long line} -setup {
+    set f [open $path(test3) w]
+    puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
+    puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
+    puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
+    puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
+    puts $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
+    close $f
+} -body {
     set f [open $path(test3)]
     set x [chan gets $f y]
     chan close $f
     list $x $y
-} {260 abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ}
+} -result {260 abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ}
 test chan-io-33.6 {Tcl_Gets and end of file} -setup {
     file delete $path(test3)
     set x {}
@@ -6765,7 +6773,12 @@ test chan-io-52.10 {TclCopyChannel & encodings} {fcopy} {
     chan close $out
     file size $path(utf8-fcopy.txt)
 } 5
-test chan-io-52.11 {TclCopyChannel & encodings} {fcopy} {
+test chan-io-52.11 {TclCopyChannel & encodings} -setup {
+    set f [open $path(utf8-fcopy.txt) w]
+    fconfigure $f -encoding utf-8
+    puts $f "\u0410\u0410"
+    close $f
+} -constraints {fcopy} -body {
     # binary to encoding => the input has to be in utf-8 to make sense to the
     # encoder
     set in  [open $path(utf8-fcopy.txt) r]
@@ -6777,7 +6790,9 @@ test chan-io-52.11 {TclCopyChannel & encodings} {fcopy} {
     chan close $in
     chan close $out
     file size $path(kyrillic.txt)
-} 3
+} -cleanup {
+    file delete $path(utf8-fcopy.txt)
+} -result 3
 
 test chan-io-53.1 {CopyData} -setup {
     file delete $path(test1)
diff --git a/tests/cmdAH.test b/tests/cmdAH.test
index ef933cb..6418aae 100644
--- a/tests/cmdAH.test
+++ b/tests/cmdAH.test
@@ -141,9 +141,13 @@ test cmdAH-2.6.2 {cd} -constraints {unix nonPortable} -setup {
 } -cleanup {
     cd $dir
 } -result {/}
-test cmdAH-2.6.3 {Tcl_CdObjCmd, bug #3118489} -returnCodes error -body {
+test cmdAH-2.6.3 {Tcl_CdObjCmd, bug #3118489} -setup {
+    set dir [pwd]
+} -returnCodes error -body {
     cd .\0
-} -result "couldn't change working directory to \".\0\": no such file or directory"
+} -cleanup {
+    cd $dir
+} -match glob -result "couldn't change working directory to \".\0\": *"
 test cmdAH-2.7 {Tcl_ConcatObjCmd} {
     concat
 } {}
diff --git a/tests/env.test b/tests/env.test
index 9f59fbc..0dd4f98 100644
--- a/tests/env.test
+++ b/tests/env.test
@@ -19,7 +19,7 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
 # Some tests require the "exec" command.
 # Skip them if exec is not defined.
 testConstraint exec [llength [info commands exec]]
-
+
 #
 # These tests will run on any platform (and indeed crashed on the Mac). So put
 # them before you test for the existance of exec.
@@ -147,6 +147,7 @@ test env-2.2 {adding environment variables} -setup {
 } -result {NAME1=test string}
 test env-2.3 {adding environment variables} -setup {
     encoding system iso8859-1
+    set env(NAME1) "test string"
 } -constraints {exec} -body {
     set env(NAME2) "more"
     getenv
@@ -156,6 +157,8 @@ test env-2.3 {adding environment variables} -setup {
 NAME2=more}
 test env-2.4 {adding environment variables} -setup {
     encoding system iso8859-1
+    set env(NAME1) "test string"
+    set env(NAME2) "more"
 } -constraints {exec} -body {
     set env(XYZZY) "garbage"
     getenv
@@ -165,7 +168,9 @@ test env-2.4 {adding environment variables} -setup {
 NAME2=more
 XYZZY=garbage}
 
+set env(NAME1) "test string"
 set env(NAME2) "new value"
+set env(XYZZY) "garbage"
 test env-3.1 {changing environment variables} -setup {
     encoding system iso8859-1
 } -constraints {exec} -body {
@@ -177,6 +182,7 @@ test env-3.1 {changing environment variables} -setup {
 } -result {NAME1=test string
 NAME2=new value
 XYZZY=garbage}
+unset -nocomplain env(NAME2)
 
 test env-4.1 {unsetting environment variables: default} -setup {
     encoding system iso8859-1
@@ -195,6 +201,7 @@ test env-4.2 {unsetting environment variables} -setup {
     unset env(XYZZY)
     encoding system $sysenc
 } -result {XYZZY=garbage}
+unset -nocomplain env(NAME1) env(XYZZY)
 test env-4.3 {setting international environment variables} -setup {
     encoding system iso8859-1
 } -constraints {exec} -body {
@@ -213,6 +220,7 @@ test env-4.4 {changing international environment variables} -setup {
 } -result {\u00a7=\u00a7}
 test env-4.5 {unsetting international environment variables} -setup {
     encoding system iso8859-1
+    set env(\ua7) \ua7
 } -body {
     set env(\ub6) \ua7
     unset env(\ua7)
@@ -323,7 +331,7 @@ test env-7.3 {[9b4702]: testing existence of env(some_thing) should not destroy
       return [info exists ::env(test7_3)]
     }}
 } -result 1
-
+
 # Restore the environment variables at the end of the test.
 
 foreach name [array names env] {
diff --git a/tests/history.test b/tests/history.test
index c562796..7549beb 100644
--- a/tests/history.test
+++ b/tests/history.test
@@ -233,6 +233,7 @@ if {[testConstraint history]} {
 test history-8.1 {clear option} history {catch {history clear junk}} 1
 test history-8.2 {clear option} history {history clear} {}
 if {[testConstraint history]} {
+    history clear
     history add "Testing"
 }
 test history-8.3 {clear option} history {history} {     1  Testing}
@@ -248,3 +249,7 @@ test history-9.2 {miscellaneous} history {
 # cleanup
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# End:
-- 
cgit v0.12


From 048a4d7e224034d072341b7c9c633801ca9fa19b Mon Sep 17 00:00:00 2001
From: ashok <ashok>
Date: Fri, 15 Jul 2016 03:12:09 +0000
Subject: Fix docs and test failures. I had rolled back .PS1 (Powershell files)
 as being executable without fixing tests and docs.

---
 doc/file.n          | 2 +-
 tests/cmdAH.test    | 7 ++++---
 tests/fileName.test | 4 ++--
 3 files changed, 7 insertions(+), 6 deletions(-)

diff --git a/doc/file.n b/doc/file.n
index 58b03d8..2f8b70c 100644
--- a/doc/file.n
+++ b/doc/file.n
@@ -164,7 +164,7 @@ returns \fB/home\fR (or something similar).
 Returns \fB1\fR if file \fIname\fR is executable by the current user,
 \fB0\fR otherwise. On Windows, which does not have an executable attribute,
 the command treats all directories and any files with extensions
-\fBexe\fR, \fBcom\fR, \fBcmd\fR, \fBbat\fR or \fBps1\fR as executable.
+\fBexe\fR, \fBcom\fR, \fBcmd\fR or \fBbat\fR as executable.
 .TP
 \fBfile exists \fIname\fR
 .
diff --git a/tests/cmdAH.test b/tests/cmdAH.test
index 6418aae..b4ef605 100644
--- a/tests/cmdAH.test
+++ b/tests/cmdAH.test
@@ -882,9 +882,10 @@ test cmdAH-18.3 {Tcl_FileObjCmd: executable} {unix testchmod} {
 } 1
 test cmdAH-18.5 {Tcl_FileObjCmd: executable} -constraints {win} -body {
     # On pc, must be a .exe, .com, etc.
-    set x [file exe $gorpfile]
+    set x {}
     set gorpexes {}
-    foreach ext {exe com cmd bat ps1} {
+    foreach ext {exe com cmd bat} {
+        lappend x [file exe nosuchfile.$ext]
         set gorpexe [makeFile foo gorp.$ext]
         lappend gorpexes $gorpexe
         lappend x [file exe $gorpexe] [file exe [string toupper $gorpexe]]
@@ -894,7 +895,7 @@ test cmdAH-18.5 {Tcl_FileObjCmd: executable} -constraints {win} -body {
     foreach gorpexe $gorpexes {
         removeFile $gorpexe
     }
-} -result {0 1 1 1 1 1 1 1 1 1 1}
+} -result {0 1 1 0 1 1 0 1 1 0 1 1}
 test cmdAH-18.6 {Tcl_FileObjCmd: executable} {} {
     # Directories are always executable.
     file exe $dirfile
diff --git a/tests/fileName.test b/tests/fileName.test
index a19bd1e..387d844 100644
--- a/tests/fileName.test
+++ b/tests/fileName.test
@@ -1468,7 +1468,7 @@ if {[testConstraint testsetplatform]} {
 }
 test filename-17.2 {windows specific glob with executable} -body {
     makeDirectory execglob
-    foreach ext {exe com cmd bat ps1 notexecutable} {
+    foreach ext {exe com cmd bat notexecutable} {
         makeFile contents execglob/abc.$ext
     }
     lsort [glob -nocomplain -dir [temporaryDirectory]/execglob -tails -types x *]
@@ -1477,7 +1477,7 @@ test filename-17.2 {windows specific glob with executable} -body {
         removeFile execglob/abc.$ext
     }
     removeDirectory execglob
-} -result {abc.bat abc.cmd abc.com abc.exe abc.ps1}
+} -result {abc.bat abc.cmd abc.com abc.exe}
 test filename-17.3 {Bug 2571597} win {
     set p /a
     file pathtype $p
-- 
cgit v0.12


From cbd642eea303b0db3eec81529c27f2045984f22a Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Fri, 15 Jul 2016 05:39:09 +0000
Subject: [77d58e3a7a] Test case independence: interp.

---
 tests/interp.test | 47 +++++++++++++++++++++++++++++++++--------------
 1 file changed, 33 insertions(+), 14 deletions(-)

diff --git a/tests/interp.test b/tests/interp.test
index 4bc9fe2..f9c1aec 100644
--- a/tests/interp.test
+++ b/tests/interp.test
@@ -71,9 +71,11 @@ test interp-2.2 {basic interpreter creation} {
 test interp-2.3 {basic interpreter creation} {
     catch {interp create -safe}
 } 0 
-test interp-2.4 {basic interpreter creation} {
-    list [catch {interp create a} msg] $msg
-} {1 {interpreter named "a" already exists, cannot create}}
+test interp-2.4 {basic interpreter creation} -setup {
+    catch {interp create a}
+} -returnCodes error -body {
+    interp create a
+} -result {interpreter named "a" already exists, cannot create}
 test interp-2.5 {basic interpreter creation} {
     interp create b -safe
 } b
@@ -89,11 +91,13 @@ test interp-2.8 {basic interpreter creation} {
 test interp-2.9 {basic interpreter creation} {
     interp create -safe -- -froboz1
 } -froboz1
-test interp-2.10 {basic interpreter creation} {
+test interp-2.10 {basic interpreter creation} -setup {
+    catch {interp create a}
+} -body {
     interp create {a x1}
     interp create {a x2}
     interp create {a x3} -safe
-} {a x3}
+} -result {a x3}
 test interp-2.11 {anonymous interps vs existing procs} {
     set x [interp create]
     regexp "interp(\[0-9]+)" $x dummy thenum
@@ -140,19 +144,26 @@ test interp-3.5 {testing interp exists and interp slaves} -body {
 test interp-3.6 {testing interp exists and interp slaves} {
     interp exists
 } 1
-test interp-3.7 {testing interp exists and interp slaves} {
+test interp-3.7 {testing interp exists and interp slaves} -setup {
+    catch {interp create a}
+} -body {
     interp slaves
-} a
+} -result a
 test interp-3.8 {testing interp exists and interp slaves} -body {
     interp slaves a b c
 } -returnCodes error -result {wrong # args: should be "interp slaves ?path?"}
-test interp-3.9 {testing interp exists and interp slaves} {
+test interp-3.9 {testing interp exists and interp slaves} -setup {
+    catch {interp create a}
+} -body {
     interp create {a a2} -safe
     expr {"a2" in [interp slaves a]}
-} 1
-test interp-3.10 {testing interp exists and interp slaves} {
+} -result 1
+test interp-3.10 {testing interp exists and interp slaves} -setup {
+    catch {interp create a}
+    catch {interp create {a a2}}
+} -body {
     interp exists {a a2}
-} 1
+} -result 1
 
 # Part 3: Testing "interp delete"
 test interp-3.11 {testing interp delete} {
@@ -222,6 +233,7 @@ test interp-6.3 {testing eval} {
     a eval {proc foo {} {expr 3 + 5}}
     a eval foo
 } 8
+catch {a eval {proc foo {} {expr 3 + 5}}}
 test interp-6.4 {testing eval} {
     interp eval a foo
 } 8
@@ -230,6 +242,7 @@ test interp-6.5 {testing eval} {
     interp eval {a x2} {proc frob {} {expr 4 * 9}}
     interp eval {a x2} frob
 } 36
+catch {interp create {a x2}}
 test interp-6.6 {testing eval} -returnCodes error -body {
     interp eval {a x2} foo
 } -result {invalid command name "foo"}
@@ -243,9 +256,11 @@ proc in_master {args} {
 test interp-7.1 {testing basic alias creation} {
     a alias foo in_master
 } foo
+catch {a alias foo in_master}
 test interp-7.2 {testing basic alias creation} {
     a alias bar in_master a1 a2 a3
 } bar
+catch {a alias bar in_master a1 a2 a3}
 # Test 6.3 has been deleted.
 test interp-7.3 {testing basic alias creation} {
     a alias foo
@@ -476,9 +491,13 @@ test interp-13.4 {testing issafe arg checking} {
 } {1 {wrong # args: should be "a issafe"}}
 
 # part 14: testing interp aliases
-test interp-14.1 {testing interp aliases} {
-    interp aliases
-} ""
+test interp-14.1 {testing interp aliases} -setup {
+    interp create abc
+} -body {
+    interp eval abc {interp aliases}
+} -cleanup {
+    interp delete abc
+} -result ""
 test interp-14.2 {testing interp aliases} {
     catch {interp delete a}
     interp create a
-- 
cgit v0.12


From 9015a7b063d96172512c54d84395d2b260d4d330 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Sat, 16 Jul 2016 11:42:38 +0000
Subject: [77d58e3a7a] Test case independence: io, load, msgcat, namespace,
 safe.

---
 tests/io.test        | 16 ++++++++++++++--
 tests/load.test      | 54 ++++++++++++++++++++++++++++++++++------------------
 tests/msgcat.test    | 11 +++++++++--
 tests/namespace.test | 13 ++++++++-----
 tests/safe.test      | 20 ++++++-------------
 5 files changed, 72 insertions(+), 42 deletions(-)

diff --git a/tests/io.test b/tests/io.test
index 6b6ad6d..9573cc6 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -4285,6 +4285,13 @@ test io-33.4 {Tcl_Gets with long line} {
     close $f
     set x
 } {abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ}
+set f [open $path(test3) w]
+puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
+puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
+puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
+puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
+puts $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
+close $f
 test io-33.5 {Tcl_Gets with long line} {
     set f [open $path(test3)]
     set x [gets $f y]
@@ -7141,7 +7148,12 @@ test io-52.10 {TclCopyChannel & encodings} {fcopy} {
 
     file size $path(utf8-fcopy.txt)
 } 5
-test io-52.11 {TclCopyChannel & encodings} {fcopy} {
+test io-52.11 {TclCopyChannel & encodings} -setup {
+    set out [open $path(utf8-fcopy.txt) w]
+    fconfigure $out -encoding utf-8 -translation lf
+    puts $out "\u0410\u0410"
+    close $out
+} -constraints {fcopy} -body {
     # binary to encoding => the input has to be
     # in utf-8 to make sense to the encoder
 
@@ -7157,7 +7169,7 @@ test io-52.11 {TclCopyChannel & encodings} {fcopy} {
     close $out
 
     file size $path(kyrillic.txt)
-} 3
+} -result 3
 
 test io-52.12 {coverage of -translation auto} {
     file delete $path(test1) $path(test2)
diff --git a/tests/load.test b/tests/load.test
index 9536271..7c4b47f 100644
--- a/tests/load.test
+++ b/tests/load.test
@@ -124,9 +124,11 @@ test load-3.2 {error in _Init procedure, slave interpreter} \
 test load-4.1 {reloading package into same interpreter} [list $dll $loaded] {
     list [catch {load [file join $testDir pkga$ext] pkga} msg] $msg
 } {0 {}}
-test load-4.2 {reloading package into same interpreter} [list $dll $loaded] {
-    list [catch {load [file join $testDir pkga$ext] pkgb} msg] $msg
-} [list 1 "file \"[file join $testDir pkga$ext]\" is already loaded for package \"Pkga\""]
+test load-4.2 {reloading package into same interpreter} -setup {
+    catch {load [file join $testDir pkga$ext] pkga}
+} -constraints [list $dll $loaded] -returnCodes error -body {
+    load [file join $testDir pkga$ext] pkgb
+} -result "file \"[file join $testDir pkga$ext]\" is already loaded for package \"Pkga\""
 
 test load-5.1 {file name not specified and no static package: pick default} \
 	[list $dll $loaded] {
@@ -169,26 +171,40 @@ test load-7.3 {Tcl_StaticPackage procedure} [list teststaticpkg] {
     load {} More
     set x
 } {not loaded}
-test load-7.4 {Tcl_StaticPackage procedure, redundant calls} \
-    [list teststaticpkg $dll $loaded] {
-	teststaticpkg Double 0 1
-	teststaticpkg Double 0 1
-	info loaded
-    } [concat [list {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkge$ext] Pkge] [list [file join $testDir pkgb$ext] Pkgb] [list [file join $testDir pkga$ext] Pkga]] $alreadyTotalLoaded]
+catch {load [file join $testDir pkga$ext] pkga}
+catch {load [file join $testDir pkgb$ext] pkgb}
+catch {load [file join $testDir pkge$ext] pkge}
+set currentRealPackages [list [list [file join $testDir pkge$ext] Pkge] [list [file join $testDir pkgb$ext] Pkgb] [list [file join $testDir pkga$ext] Pkga]]
+test load-7.4 {Tcl_StaticPackage procedure, redundant calls} -setup {
+    teststaticpkg Test 1 0
+    teststaticpkg Another 0 0
+    teststaticpkg More 0 1
+} -constraints [list teststaticpkg $dll $loaded] -body {
+    teststaticpkg Double 0 1
+    teststaticpkg Double 0 1
+    info loaded
+} -result [list {{} Double} {{} More} {{} Another} {{} Test} {*}$currentRealPackages {*}$alreadyTotalLoaded]
 
+teststaticpkg Test 1 1
+teststaticpkg Another 0 1
+teststaticpkg More 0 1
+teststaticpkg Double 0 1
 test load-8.1 {TclGetLoadedPackages procedure} [list teststaticpkg $dll $loaded] {
-    info loaded
-} [concat [list {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkge$ext] Pkge] [list [file join $testDir pkgb$ext] Pkgb] [list [file join $testDir pkga$ext] Pkga]] $alreadyTotalLoaded]
-test load-8.2 {TclGetLoadedPackages procedure} [list teststaticpkg] {
-    list [catch {info loaded gorp} msg] $msg
-} {1 {could not find interpreter "gorp"}}
-test load-8.3 {TclGetLoadedPackages procedure} [list teststaticpkg $dll $loaded] {
-    list [info loaded {}] [info loaded child]
-} [list [concat [list {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkga$ext] Pkga]] $alreadyLoaded] [list {{} Test} [list [file join $testDir pkgb$ext] Pkgb]]]
+    lsort -index 1 [info loaded]
+} [lsort -index 1 [list {{} Double} {{} More} {{} Another} {{} Test} {*}$currentRealPackages {*}$alreadyTotalLoaded]]
+test load-8.2 {TclGetLoadedPackages procedure} -body {
+    info loaded gorp
+} -returnCodes error -result {could not find interpreter "gorp"}
+test load-8.3a {TclGetLoadedPackages procedure} [list teststaticpkg $dll $loaded] {
+    lsort -index 1 [info loaded {}]
+} [lsort -index 1 [list {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkga$ext] Pkga] [list [file join $testDir pkgb$ext] Pkgb] {*}$alreadyLoaded]]
+test load-8.3b {TclGetLoadedPackages procedure} [list teststaticpkg $dll $loaded] {
+    lsort -index 1 [info loaded child]
+} [lsort -index 1 [list {{} Test} [list [file join $testDir pkgb$ext] Pkgb]]]
 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_demo pkgb_sub pkgb_unsafe}]
+    list [lsort -index 1 [info loaded {}]] [lsort [info commands pkgb_*]]
+} [list [lsort -index 1 [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/msgcat.test b/tests/msgcat.test
index 8647f9c..ae35272 100644
--- a/tests/msgcat.test
+++ b/tests/msgcat.test
@@ -68,6 +68,7 @@ namespace eval ::msgcat::test {
 		set result c
 	    }
 	}
+
 	test msgcat-0.$count [list \
 	    locale initialization from environment variables $setVars \
 	] -setup {
@@ -973,7 +974,10 @@ namespace eval ::msgcat::test {
     }
     set bgerrorsaved [interp bgerror {}]
     interp bgerror {} [namespace code callbackproc]
-    
+
+    variable locale
+    if {![info exist locale]} { set locale [mclocale] }
+
 	test msgcat-14.1 {invokation loadcmd} -setup {
 	    mcforgetpackage
     	    mclocale $locale
@@ -1068,7 +1072,7 @@ namespace eval ::msgcat::test {
 	    mc k1
 	} -returnCodes 1\
 	-result {fail}
-
+
     interp bgerror {} $bgerrorsaved
 
     cleanupTests
@@ -1076,3 +1080,6 @@ namespace eval ::msgcat::test {
 namespace delete ::msgcat::test
 return
 
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/namespace.test b/tests/namespace.test
index 55505f1..de7009d 100644
--- a/tests/namespace.test
+++ b/tests/namespace.test
@@ -846,6 +846,7 @@ test namespace-17.1 {Tcl_FindNamespaceVar, absolute name found} -setup {
         set ::x
     }
 } -result {314159}
+variable ::x 314159
 test namespace-17.2 {Tcl_FindNamespaceVar, absolute name found} {
     namespace eval test_ns_1 {
         variable x 777
@@ -889,23 +890,25 @@ test namespace-17.6 {Tcl_FindNamespaceVar, relative name found} -setup {
 } -result {777}
 test namespace-17.7 {Tcl_FindNamespaceVar, relative name found} {
     namespace eval test_ns_1 {
+	variable x 777
         unset x
         set x  ;# must be global x now
     }
 } {314159}
-test namespace-17.8 {Tcl_FindNamespaceVar, relative name not found} {
+test namespace-17.8 {Tcl_FindNamespaceVar, relative name not found} -body {
     namespace eval test_ns_1 {
-        list [catch {set wuzzat} msg] $msg
+        set wuzzat
     }
-} {1 {can't read "wuzzat": no such variable}}
+} -returnCodes error -result {can't read "wuzzat": no such variable}
 test namespace-17.9 {Tcl_FindNamespaceVar, relative name and TCL_GLOBAL_ONLY} {
     namespace eval test_ns_1 {
         variable a hello
     }
     set test_ns_1::a
 } {hello}
-test namespace-17.10 {Tcl_FindNamespaceVar, interference with cached varNames} {
+test namespace-17.10 {Tcl_FindNamespaceVar, interference with cached varNames} -setup {
     namespace eval test_ns_1 {}
+} -body {
     proc test_ns {} {
 	set ::test_ns_1::a 0
     }
@@ -916,7 +919,7 @@ test namespace-17.10 {Tcl_FindNamespaceVar, interference with cached varNames} {
     namespace eval test_ns_1 set a 1
     namespace delete test_ns_1
     return $a
-} 1
+} -result 1
 catch {unset a}
 catch {unset x}
 
diff --git a/tests/safe.test b/tests/safe.test
index 94c1755..6c9c6c9 100644
--- a/tests/safe.test
+++ b/tests/safe.test
@@ -211,8 +211,8 @@ test safe-7.3 {check that safe subinterpreters work} {
 } {ok {} 0}
 
 # test source control on file name
+set i "a"
 test safe-8.1 {safe source control on file} -setup {
-    set i "a"
     catch {safe::interpDelete $i}
 } -body {
     safe::interpCreate $i
@@ -221,7 +221,6 @@ test safe-8.1 {safe source control on file} -setup {
     safe::interpDelete $i
 } -result {wrong # args: should be "source ?-encoding E? fileName"}
 test safe-8.2 {safe source control on file} -setup {
-    set i "a"
     catch {safe::interpDelete $i}
 } -body {
     safe::interpCreate $i
@@ -230,7 +229,6 @@ test safe-8.2 {safe source control on file} -setup {
     safe::interpDelete $i
 } -result {wrong # args: should be "source ?-encoding E? fileName"}
 test safe-8.3 {safe source control on file} -setup {
-    set i "a"
     catch {safe::interpDelete $i}
     set log {}
     proc safe-test-log {str} {lappend ::log $str}
@@ -245,7 +243,6 @@ test safe-8.3 {safe source control on file} -setup {
     safe::interpDelete $i
 } -result {1 {permission denied} {{ERROR for slave a : ".": is a directory}}}
 test safe-8.4 {safe source control on file} -setup {
-    set i "a"
     catch {safe::interpDelete $i}
     set log {}
     proc safe-test-log {str} {global log; lappend log $str}
@@ -260,7 +257,6 @@ test safe-8.4 {safe source control on file} -setup {
     safe::interpDelete $i
 } -result {1 {permission denied} {{ERROR for slave a : "/abc/def": not in access_path}}}
 test safe-8.5 {safe source control on file} -setup {
-    set i "a"
     catch {safe::interpDelete $i}
     set log {}
     proc safe-test-log {str} {global log; lappend log $str}
@@ -279,7 +275,6 @@ test safe-8.5 {safe source control on file} -setup {
     safe::interpDelete $i
 } -result [list 1 {no such file or directory} [list "ERROR for slave a : [file join [info library] blah]:no such file or directory"]]
 test safe-8.6 {safe source control on file} -setup {
-    set i "a"
     catch {safe::interpDelete $i}
     set log {}
     proc safe-test-log {str} {global log; lappend log $str}
@@ -296,7 +291,6 @@ test safe-8.6 {safe source control on file} -setup {
     safe::interpDelete $i
 } -result [list 1 {no such file or directory} [list "ERROR for slave a : [file join [info library] blah.tcl]:no such file or directory"]]
 test safe-8.7 {safe source control on file} -setup {
-    set i "a"
     catch {safe::interpDelete $i}
     set log {}
     proc safe-test-log {str} {global log; lappend log $str}
@@ -315,7 +309,6 @@ test safe-8.7 {safe source control on file} -setup {
     safe::interpDelete $i
 } -result [list 1 {no such file or directory} [list "ERROR for slave a : [file join [info library] xxxxxxxxxxx.tcl]:no such file or directory"]]
 test safe-8.8 {safe source forbids -rsrc} -setup {
-    set i "a"
     catch {safe::interpDelete $i}
     safe::interpCreate $i
 } -body {
@@ -349,8 +342,8 @@ test safe-8.10 {safe source and return} -setup {
     removeFile $returnScript
 } -result ok
 
+set i "a"
 test safe-9.1 {safe interps' deleteHook} -setup {
-    set i "a"
     catch {safe::interpDelete $i}
     set res {}
 } -body {
@@ -365,7 +358,6 @@ test safe-9.1 {safe interps' deleteHook} -setup {
     list [interp eval $i exit] $res
 } -result {{} {arg1 arg2 a}}
 test safe-9.2 {safe interps' error in deleteHook} -setup {
-    set i "a"
     catch {safe::interpDelete $i}
     set res {}
     set log {}
@@ -531,14 +523,14 @@ test safe-11.7.1 {testing safe encoding} -setup {
 } -body {
     catch {interp eval $i encoding convertfrom} m o
     dict get $o -errorinfo
-} -returnCodes ok -cleanup {
+} -returnCodes ok -match glob -cleanup {
     unset -nocomplain m o
     safe::interpDelete $i
 } -result {wrong # args: should be "encoding convertfrom ?encoding? data"
     while executing
 "encoding convertfrom"
     invoked from within
-"::interp invokehidden interp1 encoding convertfrom"
+"::interp invokehidden interp* encoding convertfrom"
     invoked from within
 "encoding convertfrom"
     invoked from within
@@ -555,14 +547,14 @@ test safe-11.8.1 {testing safe encoding} -setup {
 } -body {
     catch {interp eval $i encoding convertto} m o
     dict get $o -errorinfo
-} -returnCodes ok -cleanup {
+} -returnCodes ok -match glob -cleanup {
     unset -nocomplain m o
     safe::interpDelete $i
 } -result {wrong # args: should be "encoding convertto ?encoding? data"
     while executing
 "encoding convertto"
     invoked from within
-"::interp invokehidden interp1 encoding convertto"
+"::interp invokehidden interp* encoding convertto"
     invoked from within
 "encoding convertto"
     invoked from within
-- 
cgit v0.12


From 812e86e692342eea4435ae5eb01bce552c7350e2 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Sun, 17 Jul 2016 11:56:28 +0000
Subject: [77d58e3a7a] Test case independence: unload.

---
 tests/tcltest.test |   7 ++-
 tests/unload.test  | 170 +++++++++++++++++++++++++++++++++++++----------------
 2 files changed, 125 insertions(+), 52 deletions(-)

diff --git a/tests/tcltest.test b/tests/tcltest.test
index e66678b..728a018 100644
--- a/tests/tcltest.test
+++ b/tests/tcltest.test
@@ -46,6 +46,7 @@ makeFile {
 
 cd [temporaryDirectory]
 testConstraint exec [llength [info commands exec]]
+
 # test -help
 # Child processes because -help [exit]s.
 test tcltest-1.1 {tcltest -help} {exec} {
@@ -1824,9 +1825,13 @@ test tcltest-26.2 {Bug/RFE 1017151} -setup {
 ---- errorInfo: body error
 *
 ---- errorInfo(cleanup): cleanup error*}
-
+
 cleanupTests
 }
 
 namespace delete ::tcltest::test
 return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/unload.test b/tests/unload.test
index 5a374c4..73f1091 100644
--- a/tests/unload.test
+++ b/tests/unload.test
@@ -45,6 +45,14 @@ testConstraint teststaticpkg [llength [info commands teststaticpkg]]
 testConstraint testsimplefilesystem \
 	[llength [info commands testsimplefilesystem]]
 
+proc loadIfNotPresent {pkg args} {
+    global testDir ext
+    set loaded [lmap x [info loaded {*}$args] {lindex $x 1}]
+    if {[string totitle $pkg] ni $loaded} {
+	load [file join $testDir $pkg$ext]
+    }
+}
+
 # Basic tests: parameter testing...
 test unload-1.1 {basic errors} -returnCodes error -body {
     unload
@@ -73,7 +81,7 @@ set pkgua_detached {}
 set pkgua_unloaded {}
 # Tests for loading/unloading in trusted (non-safe) interpreters...
 test unload-2.1 {basic loading of non-unloadable package, with guess for package name} [list $dll $loaded] {
-    load [file join $testDir pkga$ext]
+    loadIfNotPresent pkga
     list [pkga_eq abc def] [lsort [info commands pkga_*]]
 } {0 {pkga_eq pkga_quote}}
 test unload-2.2 {basic loading of unloadable package, with guess for package name} [list $dll $loaded] {
@@ -82,28 +90,43 @@ test unload-2.2 {basic loading of unloadable package, with guess for package nam
 	    [pkgua_eq abc def] [lsort [info commands pkgua_*]] \
 	    $pkgua_loaded $pkgua_detached $pkgua_unloaded
 } {{} {} {} {} 0 {pkgua_eq pkgua_quote} . {} {}}
-test unload-2.3 {basic unloading of non-unloadable package, with guess for package name} [list $dll $loaded] {
-    list [catch {unload [file join $testDir pkga$ext]} msg] \
-	    [string map [list [file join $testDir pkga$ext] file] $msg]
-} {1 {file "file" cannot be unloaded under a trusted interpreter}}
-test unload-2.4 {basic unloading of unloadable package, with guess for package name} [list $dll $loaded] {
+test unload-2.3 {basic unloading of non-unloadable package, with guess for package name} -setup {
+    loadIfNotPresent pkga
+} -constraints [list $dll $loaded] -returnCodes error -match glob -body {
+    unload [file join $testDir pkga$ext]
+} -result {file "*" cannot be unloaded under a trusted interpreter}
+test unload-2.4 {basic unloading of unloadable package, with guess for package name} -setup {
+    loadIfNotPresent pkgua
+} -constraints [list $dll $loaded] -body {
     list $pkgua_loaded $pkgua_detached $pkgua_unloaded \
 	    [unload [file join $testDir pkgua$ext]] \
 	    [info commands pkgua_*] \
 	    $pkgua_loaded $pkgua_detached $pkgua_unloaded
-} {. {} {} {} {} . . .}
-test unload-2.5 {reloading of unloaded package, with guess for package name} [list $dll $loaded] {
+} -result {. {} {} {} {} . . .}
+test unload-2.5 {reloading of unloaded package, with guess for package name} -setup {
+    if {$pkgua_loaded eq ""} {
+	loadIfNotPresent pkgua
+	unload [file join $testDir pkgua$ext]
+    }
+} -constraints [list $dll $loaded] -body {
     list $pkgua_loaded $pkgua_detached $pkgua_unloaded \
 	    [load [file join $testDir pkgua$ext]] \
 	    [pkgua_eq abc def] [lsort [info commands pkgua_*]] \
 	    $pkgua_loaded $pkgua_detached $pkgua_unloaded
-} {. . . {} 0 {pkgua_eq pkgua_quote} .. . .}
-test unload-2.6 {basic unloading of re-loaded package, with guess for package name} [list $dll $loaded] {
+} -result {. . . {} 0 {pkgua_eq pkgua_quote} .. . .}
+test unload-2.6 {basic unloading of re-loaded package, with guess for package name} -setup {
+    # Establish expected state
+    if {$pkgua_loaded eq ""} {
+	loadIfNotPresent pkgua
+	unload [file join $testDir pkgua$ext]
+	load [file join $testDir pkgua$ext]
+    }
+} -constraints [list $dll $loaded] -body {
     list $pkgua_loaded $pkgua_detached $pkgua_unloaded \
 	    [unload [file join $testDir pkgua$ext]] \
 	    [info commands pkgua_*] \
 	    $pkgua_loaded $pkgua_detached $pkgua_unloaded
-} {.. . . {} {} .. .. ..}
+} -result {.. . . {} {} .. .. ..}
 
 # Tests for loading/unloading in safe interpreters...
 interp create -safe child
@@ -127,38 +150,52 @@ test unload-3.2 {basic loading of unloadable package in a safe interpreter, with
 	    [lsort [child eval info commands pkgua_*]] \
 	    [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
 } {{{} {} {}} {} 0 {pkgua_eq pkgua_quote} {. {} {}}}
-test unload-3.3 {unloading of a package that has never been loaded from a safe interpreter} \
-	[list $dll $loaded] {
-    list [catch {unload [file join $testDir pkga$ext] {} child} msg] \
-         [string map [list [file join $testDir pkga$ext] file] $msg]
-} {1 {file "file" has never been loaded in this interpreter}}
-test unload-3.4 {basic unloading of a non-unloadable package from a safe interpreter, with guess for package name} \
-	[list $dll $loaded] {
-    list [catch {unload [file join $testDir pkgb$ext] {} child} msg] \
-         [string map [list [file join $testDir pkgb$ext] file] $msg]
-} {1 {file "file" cannot be unloaded under a safe interpreter}}
-test unload-3.5 {basic unloading of an unloadable package from a safe interpreter, with guess for package name} \
-	[list $dll $loaded] {
+test unload-3.3 {unloading of a package that has never been loaded from a safe interpreter} -setup {
+    loadIfNotPresent pkga
+} -constraints [list $dll $loaded] -returnCodes error -match glob -body {
+    unload [file join $testDir pkga$ext] {} child
+} -result {file "*" has never been loaded in this interpreter}
+test unload-3.4 {basic unloading of a non-unloadable package from a safe interpreter, with guess for package name} -setup {
+    if {[lsearch -index 1 [info loaded child] Pkgb] == -1} {
+	load [file join $testDir pkgb$ext] pKgB child
+    }
+} -constraints [list $dll $loaded] -returnCodes error -match glob -body {
+    unload [file join $testDir pkgb$ext] {} child
+} -result {file "*" cannot be unloaded under a safe interpreter}
+test unload-3.5 {basic unloading of an unloadable package from a safe interpreter, with guess for package name} -setup {
+    if {[lsearch -index 1 [info loaded child] Pkgua] == -1} {
+	load [file join $testDir pkgua$ext] pkgua child
+    }
+} -constraints [list $dll $loaded] -body {
     list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
 	    [unload [file join $testDir pkgua$ext] {} child] \
 	    [child eval info commands pkgua_*] \
 	    [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
-} {{. {} {}} {} {} {. . .}}
-test unload-3.6 {reloading of unloaded package in a safe interpreter, with guess for package name} \
-	[list $dll $loaded] {
+} -result {{. {} {}} {} {} {. . .}}
+test unload-3.6 {reloading of unloaded package in a safe interpreter, with guess for package name} -setup {
+    if {[child eval set pkgua_loaded] eq ""} {
+	load [file join $testDir pkgua$ext] {} child
+	unload [file join $testDir pkgua$ext] {} child
+    }
+} -constraints [list $dll $loaded] -body {
     list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
 	    [load [file join $testDir pkgua$ext] {} child] \
 	    [child eval pkgua_eq abc def] \
 	    [lsort [child eval info commands pkgua_*]] \
 	    [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
-} {{. . .} {} 0 {pkgua_eq pkgua_quote} {.. . .}}
-test unload-3.7 {basic unloading of re-loaded package from a safe interpreter, with package name conversion} \
-	[list $dll $loaded] {
+} -result {{. . .} {} 0 {pkgua_eq pkgua_quote} {.. . .}}
+test unload-3.7 {basic unloading of re-loaded package from a safe interpreter, with package name conversion} -setup {
+    if {[child eval set pkgua_loaded] eq ""} {
+	load [file join $testDir pkgua$ext] {} child
+	unload [file join $testDir pkgua$ext] {} child
+	load [file join $testDir pkgua$ext] {} child
+    }
+} -constraints [list $dll $loaded] -body {
     list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
 	    [unload [file join $testDir pkgua$ext] pKgUa child] \
 	    [child eval info commands pkgua_*] \
 	    [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
-} {{.. . .} {} {} {.. .. ..}}
+} -result {{.. . .} {} {} {.. .. ..}}
 
 # Tests for loading/unloading of a package among multiple interpreters...
 interp create child-trusted
@@ -167,56 +204,89 @@ child-trusted eval {
     set pkgua_detached {}
     set pkgua_unloaded {}
 }
+array set load {M 0 C 0 T 0}
 ## Load package in main trusted interpreter...
-test unload-4.1 {loading of unloadable package in trusted interpreter, with guess for package name} \
-	[list $dll $loaded] {
+test unload-4.1 {loading of unloadable package in trusted interpreter, with guess for package name} -setup {
+    set pkgua_loaded ""
+    set pkgua_detached ""
+    set pkgua_unloaded ""
+    incr load(M)
+} -constraints [list $dll $loaded] -body {
     list [list $pkgua_loaded $pkgua_detached $pkgua_unloaded] \
 	    [load [file join $testDir pkgua$ext]] \
 	    [pkgua_eq abc def] [lsort [info commands pkgua_*]] \
 	    [list $pkgua_loaded $pkgua_detached $pkgua_unloaded]
-} {{.. .. ..} {} 0 {pkgua_eq pkgua_quote} {... .. ..}}
+} -result {{{} {} {}} {} 0 {pkgua_eq pkgua_quote} {. {} {}}}
 ## Load package in child-safe interpreter...
-test unload-4.2 {basic loading of unloadable package in a safe interpreter, with package name conversion} \
-	[list $dll $loaded] {
+test unload-4.2 {basic loading of unloadable package in a safe interpreter, with package name conversion} -setup {
+    child eval {
+	set pkgua_loaded ""
+	set pkgua_detached ""
+	set pkgua_unloaded ""
+    }
+    incr load(C)
+} -constraints [list $dll $loaded] -body {
     list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
 	    [load [file join $testDir pkgua$ext] pKgUA child] \
 	    [child eval pkgua_eq abc def] \
 	    [lsort [child eval info commands pkgua_*]] \
 	    [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
-} {{.. .. ..} {} 0 {pkgua_eq pkgua_quote} {... .. ..}}
+} -result {{{} {} {}} {} 0 {pkgua_eq pkgua_quote} {. {} {}}}
 ## Load package in child-trusted interpreter...
-test unload-4.3 {basic loading of unloadable package in a second trusted interpreter, with package name conversion} \
-	[list $dll $loaded] {
+test unload-4.3 {basic loading of unloadable package in a second trusted interpreter, with package name conversion} -setup {
+    incr load(T)
+} -constraints [list $dll $loaded] -body {
     list [child-trusted eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
 	    [load [file join $testDir pkgua$ext] pkguA child-trusted] \
 	    [child-trusted eval pkgua_eq abc def] \
 	    [lsort [child-trusted eval info commands pkgua_*]] \
 	    [child-trusted eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
-} {{{} {} {}} {} 0 {pkgua_eq pkgua_quote} {. {} {}}}
+} -result {{{} {} {}} {} 0 {pkgua_eq pkgua_quote} {. {} {}}}
 ## Unload the package from the main trusted interpreter...
-test unload-4.4 {basic unloading of unloadable package from trusted interpreter, with guess for package name} \
-	[list $dll $loaded] {
+test unload-4.4 {basic unloading of unloadable package from trusted interpreter, with guess for package name} -setup {
+    if {!$load(M)} {
+	load [file join $testDir pkgua$ext]
+    }
+    if {!$load(C)} {
+	load [file join $testDir pkgua$ext] {} child
+	incr load(C)
+    }
+    if {!$load(T)} {
+	load [file join $testDir pkgua$ext] {} child-trusted
+	incr load(T)
+    }
+} -constraints [list $dll $loaded] -body {
     list [list $pkgua_loaded $pkgua_detached $pkgua_unloaded] \
 	    [unload [file join $testDir pkgua$ext]] \
 	    [info commands pkgua_*] \
 	    [list $pkgua_loaded $pkgua_detached $pkgua_unloaded]
-} {{... .. ..} {} {} {... ... ..}}
+} -result {{. {} {}} {} {} {. . {}}}
 ## Unload the package from the child safe interpreter...
-test unload-4.5 {basic unloading of unloadable package from a safe interpreter, with guess for package name} \
-	[list $dll $loaded] {
+test unload-4.5 {basic unloading of unloadable package from a safe interpreter, with guess for package name} -setup {
+    if {!$load(C)} {
+	load [file join $testDir pkgua$ext] {} child
+    }
+    if {!$load(T)} {
+	load [file join $testDir pkgua$ext] {} child-trusted
+	incr load(T)
+    }
+} -constraints [list $dll $loaded] -body {
     list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
 	    [unload [file join $testDir pkgua$ext] {} child] \
 	    [child eval info commands pkgua_*] \
 	    [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
-} {{... .. ..} {} {} {... ... ..}}
+} -result {{. {} {}} {} {} {. . {}}}
 ## Unload the package from the child trusted interpreter...
-test unload-4.6 {basic unloading of unloadable package from a safe interpreter, with guess for package name} \
-	[list $dll $loaded] {
+test unload-4.6 {basic unloading of unloadable package from a safe interpreter, with guess for package name} -setup {
+    if {!$load(T)} {
+	load [file join $testDir pkgua$ext] {} child-trusted
+    }
+} -constraints [list $dll $loaded] -body {
     list [child-trusted eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
 	    [unload [file join $testDir pkgua$ext] {} child-trusted] \
 	    [child-trusted eval info commands pkgua_*] \
 	    [child-trusted eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
-} {{. {} {}} {} {} {. . .}}
+} -result {{. {} {}} {} {} {. . .}}
 
 test unload-5.1 {unload a module loaded from vfs} \
      -constraints [list $dll $loaded testsimplefilesystem] \
@@ -230,9 +300,7 @@ test unload-5.1 {unload a module loaded from vfs} \
 	list [catch {unload simplefs:/pkgua$ext} msg] $msg
     } \
     -result {0 {}}
-
-
-
+
 # cleanup
 interp delete child
 interp delete child-trusted
-- 
cgit v0.12


From 30b6493bb7a01568ed7fa236badef647b30ad038 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Sun, 17 Jul 2016 12:02:27 +0000
Subject: [77d58e3a7a] Test case independence: var.

---
 tests/var.test | 6 ++++--
 1 file changed, 4 insertions(+), 2 deletions(-)

diff --git a/tests/var.test b/tests/var.test
index 690bd10..297034a 100644
--- a/tests/var.test
+++ b/tests/var.test
@@ -169,7 +169,9 @@ test var-1.17 {TclLookupVar, resurrect array element via upvar to deleted array:
 	set result
     }
 } {0 2 1 {can't set "foo": upvar refers to element in deleted array}}
-test var-1.18 {TclLookupVar, resurrect array element via upvar to deleted array: uncompiled code path} {
+test var-1.18 {TclLookupVar, resurrect array element via upvar to deleted array: uncompiled code path} -setup {
+    unset -nocomplain test_ns_var::x
+} -body {
     namespace eval test_ns_var {
 	variable result {}
 	variable x
@@ -181,7 +183,7 @@ test var-1.18 {TclLookupVar, resurrect array element via upvar to deleted array:
         namespace delete [namespace current]
 	set result
     }
-} {0 2 1 {can't set "foo": upvar refers to element in deleted array}}
+} -result {0 2 1 {can't set "foo": upvar refers to element in deleted array}}
 test var-1.19 {TclLookupVar, right error message when parsing variable name} -body {
     [format set] thisvar(doesntexist)
 } -returnCodes error -result {can't read "thisvar(doesntexist)": no such variable}
-- 
cgit v0.12


From a127a9e4aa8b2a9a386cd7fe694bfef8f1cf5264 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Mon, 18 Jul 2016 16:26:44 +0000
Subject: [104f2885bb] Rework the "chan" Tcl_ObjType to properly validate
 cached channel name lookups.

---
 generic/tclIO.c | 161 ++++++++++++++++++++++++++------------------------------
 generic/tclIO.h |   6 +--
 tests/io.test   |  19 +++++++
 3 files changed, 97 insertions(+), 89 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 7bc849e..615fe60 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -312,14 +312,20 @@ static int WillRead(Channel *chanPtr);
 		&& (strncmp(optionName, (nameString), len) == 0))
 
 /*
- * The ChannelObjType type.  We actually store the ChannelState structure
- * as that lives longest and we want to return the bottomChanPtr when
- * requested (consistent with Tcl_GetChannel).  The setFromAny and
- * updateString can be NULL as they should not be called.
+ * The ChannelObjType type.  Used to store the result of looking up
+ * a channel name in the context of an interp.  Saves the lookup
+ * result and values needed to check its continued validity.
  */
 
+typedef struct ResolvedChanName {
+    ChannelState *statePtr;	/* The saved lookup result */
+    Tcl_Interp *interp;		/* The interp in which the lookup was done. */
+    int epoch;			/* The epoch of the channel when the lookup
+				 * was done. Use to verify validity. */
+    int refCount;		/* Share this struct among many Tcl_Obj. */
+} ResolvedChanName;
+
 static void		DupChannelIntRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr);
-static int		SetChannelFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
 static void		FreeChannelIntRep(Tcl_Obj *objPtr);
 
 static Tcl_ObjType chanObjType = {
@@ -327,18 +333,9 @@ static Tcl_ObjType chanObjType = {
     FreeChannelIntRep,		/* freeIntRepProc */
     DupChannelIntRep,		/* dupIntRepProc */
     NULL,			/* updateStringProc */
-    NULL			/* setFromAnyProc SetChannelFromAny */
+    NULL			/* setFromAnyProc */
 };
 
-#define GET_CHANNELSTATE(objPtr) \
-    ((ChannelState *) (objPtr)->internalRep.twoPtrValue.ptr1)
-#define SET_CHANNELSTATE(objPtr, storePtr) \
-    ((objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (storePtr))
-#define GET_CHANNELINTERP(objPtr) \
-    ((Tcl_Interp *) (objPtr)->internalRep.twoPtrValue.ptr2)
-#define SET_CHANNELINTERP(objPtr, storePtr) \
-    ((objPtr)->internalRep.twoPtrValue.ptr2 = (void *) (storePtr))
-
 #define BUSY_STATE(st,fl) \
      ((((st)->csPtrR) && ((fl) & TCL_READABLE)) || \
       (((st)->csPtrW) && ((fl) & TCL_WRITABLE)))
@@ -936,7 +933,7 @@ DeleteChannelTable(
 	 */
 
 	Tcl_DeleteHashEntry(hPtr);
-	SetFlag(statePtr, CHANNEL_TAINTED);
+	statePtr->epoch++;
 	statePtr->refCount--;
 	if (statePtr->refCount <= 0) {
 	    if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
@@ -1280,7 +1277,7 @@ DetachChannel(
 	    return TCL_ERROR;
 	}
 	Tcl_DeleteHashEntry(hPtr);
-	SetFlag(statePtr, CHANNEL_TAINTED);
+	statePtr->epoch++;
 
 	/*
 	 * Remove channel handlers that refer to this interpreter, so that
@@ -1413,12 +1410,57 @@ TclGetChannelFromObj(
     int flags)
 {
     ChannelState *statePtr;
+    ResolvedChanName *resPtr = NULL;
+    Tcl_Channel chan;
+
+    if (interp == NULL) {
+	return TCL_ERROR;
+    }
+
+    if (objPtr->typePtr == &chanObjType) {
+	/*
+ 	 * Confirm validity of saved lookup results.
+ 	 */
+
+	resPtr = (ResolvedChanName *) objPtr->internalRep.twoPtrValue.ptr1;
+	statePtr = resPtr->statePtr;
+	if ((resPtr->interp == interp)		/* Same interp context */
+			/* No epoch change in channel since lookup */
+		&& (resPtr->epoch == statePtr->epoch)) {
+
+	    /* Have a valid saved lookup. Jump to end to return it. */
+	    goto valid;
+	}
+    }
+
+    chan = Tcl_GetChannel(interp, TclGetString(objPtr), NULL);
 
-    if (SetChannelFromAny(interp, objPtr) != TCL_OK) {
+    if (chan == NULL) {
+	if (resPtr) {
+	    FreeChannelIntRep(objPtr);
+	}
 	return TCL_ERROR;
     }
 
-    statePtr = GET_CHANNELSTATE(objPtr);
+    if (resPtr && resPtr->refCount == 1) {
+	/* Re-use the ResolvedCmdName struct */
+	Tcl_Release((ClientData) resPtr->statePtr);
+
+    } else {
+	TclFreeIntRep(objPtr);
+
+	resPtr = (ResolvedChanName *) ckalloc(sizeof(ResolvedChanName));
+	resPtr->refCount = 1;
+	objPtr->internalRep.twoPtrValue.ptr1 = (ClientData) resPtr;
+	objPtr->typePtr = &chanObjType;
+    }
+    statePtr = ((Channel *)chan)->state;
+    resPtr->statePtr = statePtr;
+    Tcl_Preserve((ClientData) statePtr);
+    resPtr->interp = interp;
+    resPtr->epoch = statePtr->epoch;
+
+  valid:
     *channelPtr = (Tcl_Channel) (statePtr->bottomChanPtr);
 
     if (modePtr != NULL) {
@@ -1568,6 +1610,8 @@ Tcl_CreateChannel(
     statePtr->chanMsg		= NULL;
     statePtr->unreportedMsg	= NULL;
 
+    statePtr->epoch		= 0;
+
     /*
      * Link the channel into the list of all channels; create an on-exit
      * handler if there is not one already, to close off all the channels in
@@ -10439,78 +10483,17 @@ DupChannelIntRep(
     register Tcl_Obj *copyPtr)	/* Object with internal rep to set. Must not
 				 * currently have an internal rep.*/
 {
-    ChannelState *statePtr  = GET_CHANNELSTATE(srcPtr);
+    ResolvedChanName *resPtr
+	    = (ResolvedChanName *) srcPtr->internalRep.twoPtrValue.ptr1;
 
-    SET_CHANNELSTATE(copyPtr, statePtr);
-    SET_CHANNELINTERP(copyPtr, GET_CHANNELINTERP(srcPtr));
-    Tcl_Preserve((ClientData) statePtr);
+    resPtr->refCount++;
+    copyPtr->internalRep.twoPtrValue.ptr1 = resPtr;
     copyPtr->typePtr = srcPtr->typePtr;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * SetChannelFromAny --
- *
- *	Create an internal representation of type "Channel" for an object.
- *
- * Results:
- *	This operation always succeeds and returns TCL_OK.
- *
- * Side effects:
- *	Any old internal reputation for objPtr is freed and the internal
- *	representation is set to "Channel".
- *
- *----------------------------------------------------------------------
- */
-
-static int
-SetChannelFromAny(
-    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
-    register Tcl_Obj *objPtr)	/* The object to convert. */
-{
-    ChannelState *statePtr;
-
-    if (interp == NULL) {
-	return TCL_ERROR;
-    }
-    if (objPtr->typePtr == &chanObjType) {
-	/*
-	 * TODO: TAINT Flag and dup'd channel values?
-	 * The channel is valid until any call to DetachChannel occurs.
-	 * Ensure consistency checks are done.
-	 */
-
-	statePtr = GET_CHANNELSTATE(objPtr);
-	if (GotFlag(statePtr, CHANNEL_TAINTED|CHANNEL_CLOSED)) {
-	    ResetFlag(statePtr, CHANNEL_TAINTED);
-	    Tcl_Release((ClientData) statePtr);
-	    objPtr->typePtr = NULL;
-	} else if (interp != GET_CHANNELINTERP(objPtr)) {
-	    Tcl_Release((ClientData) statePtr);
-	    objPtr->typePtr = NULL;
-	}
-    }
-    if (objPtr->typePtr != &chanObjType) {
-	Tcl_Channel chan = Tcl_GetChannel(interp, TclGetString(objPtr), NULL);
-
-	if (chan == NULL) {
-	    return TCL_ERROR;
-	}
-
-	TclFreeIntRep(objPtr);
-	statePtr = ((Channel *)chan)->state;
-	Tcl_Preserve((ClientData) statePtr);
-	SET_CHANNELSTATE(objPtr, statePtr);
-	SET_CHANNELINTERP(objPtr, interp);
-	objPtr->typePtr = &chanObjType;
-    }
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
  * FreeChannelIntRep --
  *
  *	Release statePtr storage.
@@ -10528,7 +10511,15 @@ static void
 FreeChannelIntRep(
     Tcl_Obj *objPtr)		/* Object with internal rep to free. */
 {
-    Tcl_Release((ClientData) GET_CHANNELSTATE(objPtr));
+    ResolvedChanName *resPtr
+	    = (ResolvedChanName *) objPtr->internalRep.twoPtrValue.ptr1;
+
+    objPtr->typePtr = NULL;
+    if (--resPtr->refCount) {
+	return;
+    }
+    Tcl_Release((ClientData) resPtr->statePtr);
+    ckfree((char *)resPtr);
 }
 
 #if 0
diff --git a/generic/tclIO.h b/generic/tclIO.h
index 348a9c5..d096798 100644
--- a/generic/tclIO.h
+++ b/generic/tclIO.h
@@ -214,6 +214,8 @@ typedef struct ChannelState {
 				 * because it happened in the background. The
 				 * value is the chanMg, if any. #219's
 				 * companion to 'unreportedError'. */
+    int epoch;			/* Used to test validity of stored channelname
+				 * lookup results. */
 } ChannelState;
 
 /*
@@ -275,10 +277,6 @@ typedef struct ChannelState {
 					 * usable, but it may not be closed
 					 * again from within the close
 					 * handler. */
-#define CHANNEL_TAINTED		(1<<20)	/* Channel stack structure has changed.
-					 * Used by Channel Tcl_Obj type to
-					 * determine if we have to revalidate
-					 * the channel. */
 
 /*
  * Local Variables:
diff --git a/tests/io.test b/tests/io.test
index 50c5808..7275b42 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -38,6 +38,7 @@ testConstraint testfevent       [llength [info commands testfevent]]
 testConstraint testchannelevent [llength [info commands testchannelevent]]
 testConstraint testmainthread   [llength [info commands testmainthread]]
 testConstraint testthread       [llength [info commands testthread]]
+testConstraint testobj		[llength [info commands testobj]]
 
 # You need a *very* special environment to do some tests.  In
 # particular, many file systems do not support large-files...
@@ -8522,6 +8523,24 @@ test io-73.5 {effect of eof on encoding end flags} -setup {
     removeFile io-73.5
 } -result [list 1 1 more\u00a0data 1]
 
+test io-74.1 {[104f2885bb] improper cache validity check} -setup {
+    set fn [makeFile {} io-74.1]
+    set rfd [open $fn r]
+    testobj freeallvars
+    interp create slave
+} -constraints testobj -body {
+    teststringobj set 1 [string range $rfd 0 end]
+    read [teststringobj get 1]		
+    testobj duplicate 1 2
+    interp transfer {} $rfd slave
+    catch {read [teststringobj get 1]}
+    read [teststringobj get 2]		
+} -cleanup {
+    interp delete slave
+    testobj freeallvars
+    removeFile io-74.1
+} -returnCodes error -match glob -result {can not find channel named "*"}
+
 # ### ### ### ######### ######### #########
 
 # cleanup
-- 
cgit v0.12