From 6076256c3fd10a1dc4ab4a315fe018e68d0933ed Mon Sep 17 00:00:00 2001
From: ashok <ashok>
Date: Sun, 10 Jul 2016 06:33:20 +0000
Subject: Fix compiler warnings (const-ness and unused label) that did not show
 up in the non-optimized build before last checkin.

---
 win/tclWinFile.c | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index dbfdfd0..4d7500b 100755
--- a/win/tclWinFile.c
+++ b/win/tclWinFile.c
@@ -3159,7 +3159,7 @@ TclWinFileOwned(
 
     native = Tcl_FSGetNativePath(pathPtr);
 
-    if (GetNamedSecurityInfo(native, SE_FILE_OBJECT,
+    if (GetNamedSecurityInfo((LPTSTR) native, SE_FILE_OBJECT,
                              OWNER_SECURITY_INFORMATION, &ownerSid,
                              NULL, NULL, NULL, &secd) != ERROR_SUCCESS) {
         /* Either not a file, or we do not have access to it in which
@@ -3186,7 +3186,6 @@ TclWinFileOwned(
         CloseHandle(token);
     }
 
-vamoose:
     /* Free allocations and be done */
     if (secd)
         LocalFree(secd);            /* Also frees ownerSid */
-- 
cgit v0.12


From 31ec149e21d47b016e7febc2491c31b1cdb3f6a5 Mon Sep 17 00:00:00 2001
From: ashok <ashok>
Date: Sun, 10 Jul 2016 06:41:54 +0000
Subject: Bugfix [da340d4f32]. clock-55.9 and clock-55.10 test failures.

---
 generic/tclClock.c | 12 ++++++++++++
 1 file changed, 12 insertions(+)

diff --git a/generic/tclClock.c b/generic/tclClock.c
index 949cb1c..c3b29e9 100644
--- a/generic/tclClock.c
+++ b/generic/tclClock.c
@@ -1499,7 +1499,19 @@ GetJulianDayFromEraYearMonthDay(
      * Try an initial conversion in the Gregorian calendar.
      */
 
+#if 0 /* BUG http://core.tcl.tk/tcl/tktview?name=da340d4f32 */
     ym1o4 = ym1 / 4;
+#else
+    /*
+     * Have to make sure quotient is truncated towards 0 when negative.
+     * See above bug for details. The casts are necessary.
+     */
+    if (ym1 >= 0)
+        ym1o4 = ym1 / 4;
+    else {
+        ym1o4 = - (int) (((unsigned int) -ym1) / 4);
+    }
+#endif
     if (ym1 % 4 < 0) {
 	ym1o4--;
     }
-- 
cgit v0.12


From 75f3cb9d07f1574ab528e60672d482bcd368b364 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Sun, 10 Jul 2016 07:59:52 +0000
Subject: Fixes to namespace.test

---
 tests/namespace.test | 418 +++++++++++++++++++++++++++++++++++++--------------
 1 file changed, 306 insertions(+), 112 deletions(-)

diff --git a/tests/namespace.test b/tests/namespace.test
index dc1d3bf..575695f 100644
--- a/tests/namespace.test
+++ b/tests/namespace.test
@@ -82,12 +82,14 @@ test namespace-4.2 {Tcl_PushCallFrame with isProcCallFrame=0} {
 test namespace-5.1 {Tcl_PopCallFrame, no vars} {
     namespace eval test_ns_1::blodge {}  ;# pushes then pops frame
 } {}
-test namespace-5.2 {Tcl_PopCallFrame, local vars must be deleted} {
+test namespace-5.2 {Tcl_PopCallFrame, local vars must be deleted} -setup {
+    namespace eval test_ns_1 {}
+} -body {
     proc test_ns_1::r {} {
         set a 123
     }
     test_ns_1::r   ;# pushes then pop's r's frame
-} {123}
+} -result {123}
 
 test namespace-6.1 {Tcl_CreateNamespace} {
     catch {namespace delete {*}[namespace children :: test_ns_*]}
@@ -194,7 +196,6 @@ test namespace-7.7 {Bug 1655305} -setup {
     interp delete slave
 } -result {}
 
-
 test namespace-8.1 {TclTeardownNamespace, delete global namespace} {
     catch {interp delete test_interp}
     interp create test_interp
@@ -303,15 +304,24 @@ test namespace-9.4 {Tcl_Import, simple import} {
     }
     test_ns_import::p
 } {cmd1: 123}
-test namespace-9.5 {Tcl_Import, RFE 1230597} {
+test namespace-9.5 {Tcl_Import, RFE 1230597} -setup {
+    namespace eval test_ns_import {}
+    namespace eval test_ns_export {}
+} -body {
     list [catch {namespace eval test_ns_import {namespace import ::test_ns_export::*}} msg] $msg
-} {0 {}}
-test namespace-9.6 {Tcl_Import, cmd redefinition ok if allowOverwrite!=0} {
+} -result {0 {}}
+test namespace-9.6 {Tcl_Import, cmd redefinition ok if allowOverwrite!=0} -setup {
+    namespace eval test_ns_import {}
+    namespace eval ::test_ns_export {
+        proc cmd1 {args} {return "cmd1: $args"}
+	namespace export cmd1
+    }
+} -body {
     namespace eval test_ns_import {
         namespace import -force ::test_ns_export::*
         cmd1 555
     }
-} {cmd1: 555}
+} -result {cmd1: 555}
 test namespace-9.7 {Tcl_Import, links are preserved if cmd is redefined} {
     catch {namespace delete {*}[namespace children :: test_ns_*]}
     namespace eval test_ns_export {
@@ -329,7 +339,6 @@ test namespace-9.7 {Tcl_Import, links are preserved if cmd is redefined} {
          [test_ns_import::cmd1 g h i] \
          [test_ns_export::cmd1 j k l]
 } {{cmd1: a b c} {cmd1: d e f} {} ::test_ns_export::cmd1 ::test_ns_export::cmd1 {new1: g h i} {new1: j k l}}
-
 test namespace-9.8 {Tcl_Import: Bug 1017299} -setup {
     namespace eval one {
 	namespace export cmd
@@ -354,7 +363,6 @@ test namespace-9.8 {Tcl_Import: Bug 1017299} -setup {
 } -cleanup {
     namespace delete one two three
 } -match glob -result *::one::cmd
-
 test namespace-9.9 {Tcl_Import: Bug 1017299} -setup {
     namespace eval one {
 	namespace export cmd
@@ -388,7 +396,13 @@ test namespace-10.2 {Tcl_ForgetImport, ignores patterns that don't match} {
         namespace forget ::test_ns_export::wombat
     }
 } {}
-test namespace-10.3 {Tcl_ForgetImport, deletes matching imported cmds} {
+test namespace-10.3 {Tcl_ForgetImport, deletes matching imported cmds} -setup {
+    namespace eval test_ns_export {
+        namespace export cmd1
+        proc cmd1 {args} {return "cmd1: $args"}
+        proc cmd2 {args} {return "cmd2: $args"}
+    }
+} -body {
     namespace eval test_ns_import {
         namespace import ::test_ns_export::*
         proc p {} {return [cmd1 123]}
@@ -398,8 +412,7 @@ test namespace-10.3 {Tcl_ForgetImport, deletes matching imported cmds} {
         lappend l [info commands ::test_ns_import::*]
         lappend l [catch {cmd1 777} msg] $msg
     }
-} [list [lsort {::test_ns_import::p ::test_ns_import::cmd1}] ::test_ns_import::p 1 {invalid command name "cmd1"}]
-
+} -result [list [lsort {::test_ns_import::p ::test_ns_import::cmd1}] ::test_ns_import::p 1 {invalid command name "cmd1"}]
 test namespace-10.4 {Tcl_ForgetImport: Bug 560297} -setup {
     namespace eval origin {
 	namespace export cmd
@@ -417,7 +430,6 @@ test namespace-10.4 {Tcl_ForgetImport: Bug 560297} -setup {
 } -cleanup {
     namespace delete origin unrelated my
 }
-
 test namespace-10.5 {Tcl_ForgetImport: Bug 560297} -setup {
     namespace eval origin {
 	namespace export cmd
@@ -433,7 +445,6 @@ test namespace-10.5 {Tcl_ForgetImport: Bug 560297} -setup {
 } -cleanup {
     namespace delete origin my
 } -returnCodes error -match glob -result *
-
 test namespace-10.6 {Tcl_ForgetImport: Bug 560297} -setup {
     namespace eval origin {
 	namespace export cmd
@@ -450,7 +461,6 @@ test namespace-10.6 {Tcl_ForgetImport: Bug 560297} -setup {
 } -cleanup {
     namespace delete origin my your
 } -returnCodes error -match glob -result *
-
 test namespace-10.7 {Tcl_ForgetImport: Bug 560297} -setup {
     namespace eval origin {
 	namespace export cmd
@@ -471,7 +481,6 @@ test namespace-10.7 {Tcl_ForgetImport: Bug 560297} -setup {
 } -cleanup {
     namespace delete origin link link2 my
 } -returnCodes error -match glob -result *
-
 test namespace-10.8 {Tcl_ForgetImport: Bug 560297} -setup {
     namespace eval origin {
 	namespace export cmd
@@ -492,7 +501,6 @@ test namespace-10.8 {Tcl_ForgetImport: Bug 560297} -setup {
 } -cleanup {
     namespace delete origin link link2 my
 }
-
 test namespace-10.9 {Tcl_ForgetImport: Bug 560297} -setup {
     namespace eval origin {
 	namespace export cmd
@@ -514,29 +522,47 @@ test namespace-10.9 {Tcl_ForgetImport: Bug 560297} -setup {
     namespace delete origin link link2 my
 } -returnCodes error -match glob -result *
 
-test namespace-11.1 {TclGetOriginalCommand, check if not imported cmd} {
+test namespace-11.1 {TclGetOriginalCommand, check if not imported cmd} -setup {
     catch {namespace delete {*}[namespace children :: test_ns_*]}
+} -body {
     namespace eval test_ns_export {
         namespace export cmd1
         proc cmd1 {args} {return "cmd1: $args"}
     }
     list [namespace origin set] [namespace origin test_ns_export::cmd1]
-} {::set ::test_ns_export::cmd1}
-test namespace-11.2 {TclGetOriginalCommand, directly imported cmd} {
+} -result {::set ::test_ns_export::cmd1}
+test namespace-11.2 {TclGetOriginalCommand, directly imported cmd} -setup {
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
+    namespace eval test_ns_export {
+        namespace export cmd1
+        proc cmd1 {args} {return "cmd1: $args"}
+    }
+} -body {
     namespace eval test_ns_import1 {
         namespace import ::test_ns_export::*
         namespace export *
         proc p {} {namespace origin cmd1}
     }
     list [test_ns_import1::p] [namespace origin test_ns_import1::cmd1]
-} {::test_ns_export::cmd1 ::test_ns_export::cmd1}
-test namespace-11.3 {TclGetOriginalCommand, indirectly imported cmd} {
+} -result {::test_ns_export::cmd1 ::test_ns_export::cmd1}
+test namespace-11.3 {TclGetOriginalCommand, indirectly imported cmd} -setup {
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
+    namespace eval test_ns_export {
+        namespace export cmd1
+        proc cmd1 {args} {return "cmd1: $args"}
+    }
+    namespace eval test_ns_import1 {
+        namespace import ::test_ns_export::*
+        namespace export *
+        proc p {} {namespace origin cmd1}
+    }
+} -body {
     namespace eval test_ns_import2 {
         namespace import ::test_ns_import1::*
         proc q {} {return [cmd1 123]}
     }
     list [test_ns_import2::q] [namespace origin test_ns_import2::cmd1]
-} {{cmd1: 123} ::test_ns_export::cmd1}
+} -result {{cmd1: 123} ::test_ns_export::cmd1}
 
 test namespace-12.1 {InvokeImportedCmd} {
     catch {namespace delete {*}[namespace children :: test_ns_*]}
@@ -550,14 +576,23 @@ test namespace-12.1 {InvokeImportedCmd} {
     list [test_ns_import::cmd1]
 } {::test_ns_export}
 
-test namespace-13.1 {DeleteImportedCmd, deletes imported cmds} {
+test namespace-13.1 {DeleteImportedCmd, deletes imported cmds} -setup {
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
+    namespace eval test_ns_export {
+        namespace export cmd1
+        proc cmd1 {args} {namespace current}
+    }
+    namespace eval test_ns_import {
+        namespace import ::test_ns_export::*
+    }
+} -body {
     namespace eval test_ns_import {
         set l {}
         lappend l [info commands ::test_ns_import::*]
         namespace forget ::test_ns_export::cmd1
         lappend l [info commands ::test_ns_import::*]
     }
-} {::test_ns_import::cmd1 {}}
+} -result {::test_ns_import::cmd1 {}}
 test namespace-13.2 {DeleteImportedCmd, Bug a4494e28ed} {
     # Will panic if still buggy
     namespace eval src {namespace export foo; proc foo {} {}}
@@ -568,7 +603,7 @@ test namespace-13.2 {DeleteImportedCmd, Bug a4494e28ed} {
     namespace delete src
 } {}
 
-test namespace-14.1 {TclGetNamespaceForQualName, absolute names} {
+test namespace-14.1 {TclGetNamespaceForQualName, absolute names} -setup {
     catch {namespace delete {*}[namespace children :: test_ns_*]}
     variable v 10
     namespace eval test_ns_1::test_ns_2 {
@@ -577,22 +612,41 @@ test namespace-14.1 {TclGetNamespaceForQualName, absolute names} {
     namespace eval test_ns_2 {
         variable v 30
     }
+} -body {
     namespace eval test_ns_1 {
         list $::v $::test_ns_2::v $::test_ns_1::test_ns_2::v \
 		[lsort [namespace children :: test_ns_*]]
     }
-} [list 10 30 20 [lsort {::test_ns_1 ::test_ns_2}]]
-test namespace-14.2 {TclGetNamespaceForQualName, invalid absolute names} {
+} -result [list 10 30 20 [lsort {::test_ns_1 ::test_ns_2}]]
+test namespace-14.2 {TclGetNamespaceForQualName, invalid absolute names} -setup {
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
+    variable v 10
+    namespace eval test_ns_1::test_ns_2 {
+        variable v 20
+    }
+    namespace eval test_ns_2 {
+        variable v 30
+    }
+} -body {
     namespace eval test_ns_1 {
         list [catch {set ::test_ns_777::v} msg] $msg \
              [catch {namespace children test_ns_777} msg] $msg
     }
-} {1 {can't read "::test_ns_777::v": no such variable} 1 {namespace "test_ns_777" not found in "::test_ns_1"}}
-test namespace-14.3 {TclGetNamespaceForQualName, relative names} {
+} -result {1 {can't read "::test_ns_777::v": no such variable} 1 {namespace "test_ns_777" not found in "::test_ns_1"}}
+test namespace-14.3 {TclGetNamespaceForQualName, relative names} -setup {
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
+    variable v 10
+    namespace eval test_ns_1::test_ns_2 {
+        variable v 20
+    }
+    namespace eval test_ns_2 {
+        variable v 30
+    }
+} -body {
     namespace eval test_ns_1 {
         list $v $test_ns_2::v
     }
-} {10 20}
+} -result {10 20}
 test namespace-14.4 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} {
     namespace eval test_ns_1::test_ns_2 {
         namespace eval foo {}
@@ -619,57 +673,72 @@ test namespace-14.6 {TclGetNamespaceForQualName, relative ns names looked up onl
              [catch {namespace children test_ns_1} msg] $msg
     }
 } {::test_ns_1::test_ns_2::foo 1 {namespace "test_ns_1" not found in "::test_ns_1"}}
-test namespace-14.7 {TclGetNamespaceForQualName, ignore extra :s if ns} {
+test namespace-14.7 {TclGetNamespaceForQualName, ignore extra :s if ns} -setup {
+    namespace eval test_ns_1::test_ns_2::foo {}
+} -body {
     namespace children test_ns_1:::
-} {::test_ns_1::test_ns_2}
-test namespace-14.8 {TclGetNamespaceForQualName, ignore extra :s if ns} {
+} -result {::test_ns_1::test_ns_2}
+test namespace-14.8 {TclGetNamespaceForQualName, ignore extra :s if ns} -setup {
+    namespace eval test_ns_1::test_ns_2::foo {}
+} -body {
     namespace children :::test_ns_1:::::test_ns_2:::
-} {::test_ns_1::test_ns_2::foo}
+} -result {::test_ns_1::test_ns_2::foo}
 test namespace-14.9 {TclGetNamespaceForQualName, extra ::s are significant for vars} {
     set l {}
     lappend l [catch {set test_ns_1::test_ns_2::} msg] $msg
     namespace eval test_ns_1::test_ns_2 {variable {} 2525}
     lappend l [set test_ns_1::test_ns_2::]
 } {1 {can't read "test_ns_1::test_ns_2::": no such variable} 2525}
-test namespace-14.10 {TclGetNamespaceForQualName, extra ::s are significant for vars} {
-    catch {unset test_ns_1::test_ns_2::}
+test namespace-14.10 {TclGetNamespaceForQualName, extra ::s are significant for vars} -setup {
+    namespace eval test_ns_1::test_ns_2::foo {}
+    unset -nocomplain test_ns_1::test_ns_2::
     set l {}
+} -body {
     lappend l [catch {set test_ns_1::test_ns_2::} msg] $msg
     set test_ns_1::test_ns_2:: 314159
     lappend l [set test_ns_1::test_ns_2::]
-} {1 {can't read "test_ns_1::test_ns_2::": no such variable} 314159}
-test namespace-14.11 {TclGetNamespaceForQualName, extra ::s are significant for commands} {
+} -result {1 {can't read "test_ns_1::test_ns_2::": no such variable} 314159}
+test namespace-14.11 {TclGetNamespaceForQualName, extra ::s are significant for commands} -setup {
+    namespace eval test_ns_1::test_ns_2::foo {}
     catch {rename test_ns_1::test_ns_2:: {}}
     set l {}
+} -body {
     lappend l [catch {test_ns_1::test_ns_2:: hello} msg] $msg
     proc test_ns_1::test_ns_2:: {args} {return "\{\}: $args"}
     lappend l [test_ns_1::test_ns_2:: hello]
-} {1 {invalid command name "test_ns_1::test_ns_2::"} {{}: hello}}
-test namespace-14.12 {TclGetNamespaceForQualName, extra ::s are significant for vars} {
+} -result {1 {invalid command name "test_ns_1::test_ns_2::"} {{}: hello}}
+test namespace-14.12 {TclGetNamespaceForQualName, extra ::s are significant for vars} -setup {
     catch {namespace delete {*}[namespace children :: test_ns_*]}
+} -body {
     namespace eval test_ns_1 {
         variable {}
         set test_ns_1::(x) y
     }
     set test_ns_1::(x)
-} y
-test namespace-14.13 {TclGetNamespaceForQualName, namespace other than global ns can't have empty name} {
+} -result y
+test namespace-14.13 {TclGetNamespaceForQualName, namespace other than global ns can't have empty name} -setup {
     catch {namespace delete {*}[namespace children :: test_ns_*]}
-    list [catch {namespace eval test_ns_1 {proc {} {} {}; namespace eval {} {}; {}}} msg] $msg
-} {1 {can't create namespace "": only global namespace can have empty name}}
+} -returnCodes error -body {
+    namespace eval test_ns_1 {
+	proc {} {} {}
+	namespace eval {} {}
+	{}
+    }
+} -result {can't create namespace "": only global namespace can have empty name}
 
-test namespace-15.1 {Tcl_FindNamespace, absolute name found} {
+test namespace-15.1 {Tcl_FindNamespace, absolute name found} -setup {
     catch {namespace delete {*}[namespace children :: test_ns_*]}
+} -body {
     namespace eval test_ns_delete {
         namespace eval test_ns_delete2 {}
         proc cmd {args} {namespace current}
     }
     list [namespace delete ::test_ns_delete::test_ns_delete2] \
          [namespace children ::test_ns_delete]
-} {{} {}}
-test namespace-15.2 {Tcl_FindNamespace, absolute name not found} {
-    list [catch {namespace delete ::test_ns_delete::test_ns_delete2} msg] $msg
-} {1 {unknown namespace "::test_ns_delete::test_ns_delete2" in namespace delete command}}
+} -result {{} {}}
+test namespace-15.2 {Tcl_FindNamespace, absolute name not found} -body {
+    namespace delete ::test_ns_delete::test_ns_delete2
+} -returnCodes error -result {unknown namespace "::test_ns_delete::test_ns_delete2" in namespace delete command}
 test namespace-15.3 {Tcl_FindNamespace, relative name found} {
     namespace eval test_ns_delete {
         namespace eval test_ns_delete2 {}
@@ -685,17 +754,24 @@ test namespace-15.4 {Tcl_FindNamespace, relative name not found} {
     }
 } {1 {unknown namespace "test_ns_delete2" in namespace delete command}}
 
-test namespace-16.1 {Tcl_FindCommand, absolute name found} {
+test namespace-16.1 {Tcl_FindCommand, absolute name found} -setup {
     catch {namespace delete {*}[namespace children :: test_ns_*]}
+} -body {
     namespace eval test_ns_1 {
         proc cmd {args} {return "[namespace current]::cmd: $args"}
         variable v "::test_ns_1::cmd"
         eval $v one
     }
-} {::test_ns_1::cmd: one}
-test namespace-16.2 {Tcl_FindCommand, absolute name found} {
+} -result {::test_ns_1::cmd: one}
+test namespace-16.2 {Tcl_FindCommand, absolute name found} -setup {
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
+    namespace eval test_ns_1 {
+        proc cmd {args} {return "[namespace current]::cmd: $args"}
+        variable v "::test_ns_1::cmd"
+    }
+} -body {
     eval $test_ns_1::v two
-} {::test_ns_1::cmd: two}
+} -result {::test_ns_1::cmd: two}
 test namespace-16.3 {Tcl_FindCommand, absolute name not found} {
     namespace eval test_ns_1 {
         variable v2 "::test_ns_1::ladidah"
@@ -724,11 +800,16 @@ test namespace-16.7 {Tcl_FindCommand, relative name and TCL_GLOBAL_ONLY} {
 catch {rename unknown {}}
 catch {rename unknown.old unknown}
 
-test namespace-16.8 {Tcl_FindCommand, relative name found} {
+test namespace-16.8 {Tcl_FindCommand, relative name found} -setup {
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
+    namespace eval test_ns_1 {
+        proc cmd {args} {return "[namespace current]::cmd: $args"}
+    }
+} -body {
     namespace eval test_ns_1 {
         cmd a b c
     }
-} {::test_ns_1::cmd: a b c}
+} -result {::test_ns_1::cmd: a b c}
 test namespace-16.9 {Tcl_FindCommand, relative name found} -body {
     proc cmd2 {args} {return "[namespace current]::cmd2: $args"}
     namespace eval test_ns_1 {
@@ -750,20 +831,21 @@ test namespace-16.10 {Tcl_FindCommand, relative name found, only look in current
 } -cleanup {
     catch {rename cmd2 {}}
 } -result {::::cmd2: a b c}
-test namespace-16.11 {Tcl_FindCommand, relative name not found} {
+test namespace-16.11 {Tcl_FindCommand, relative name not found} -body {
     namespace eval test_ns_1 {
-       list [catch {cmd3 a b c} msg] $msg
+       cmd3 a b c
     }
-} {1 {invalid command name "cmd3"}}
+} -returnCodes error -result {invalid command name "cmd3"}
 
-catch {unset x}
-test namespace-17.1 {Tcl_FindNamespaceVar, absolute name found} {
+unset -nocomplain x
+test namespace-17.1 {Tcl_FindNamespaceVar, absolute name found} -setup {
     catch {namespace delete {*}[namespace children :: test_ns_*]}
+} -body {
     set x 314159
     namespace eval test_ns_1 {
         set ::x
     }
-} {314159}
+} -result {314159}
 test namespace-17.2 {Tcl_FindNamespaceVar, absolute name found} {
     namespace eval test_ns_1 {
         variable x 777
@@ -778,27 +860,33 @@ test namespace-17.3 {Tcl_FindNamespaceVar, absolute name found} {
         set ::test_ns_1::test_ns_2::x
     }
 } {1111}
-test namespace-17.4 {Tcl_FindNamespaceVar, absolute name not found} {
+test namespace-17.4 {Tcl_FindNamespaceVar, absolute name not found} -body {
     namespace eval test_ns_1 {
         namespace eval test_ns_2 {
             variable x 1111
         }
-        list [catch {set ::test_ns_1::test_ns_2::y} msg] $msg
+        set ::test_ns_1::test_ns_2::y
     }
-} {1 {can't read "::test_ns_1::test_ns_2::y": no such variable}}
-test namespace-17.5 {Tcl_FindNamespaceVar, absolute name and TCL_GLOBAL_ONLY} {
+} -returnCodes error -result {can't read "::test_ns_1::test_ns_2::y": no such variable}
+test namespace-17.5 {Tcl_FindNamespaceVar, absolute name and TCL_GLOBAL_ONLY} -setup {
+    namespace eval ::test_ns_1::test_ns_2 {}
+} -body {
     namespace eval test_ns_1 {
         namespace eval test_ns_3 {
             variable ::test_ns_1::test_ns_2::x 2222
         }
     }
     set ::test_ns_1::test_ns_2::x
-} {2222}
-test namespace-17.6 {Tcl_FindNamespaceVar, relative name found} {
+} -result {2222}
+test namespace-17.6 {Tcl_FindNamespaceVar, relative name found} -setup {
+    namespace eval test_ns_1 {
+        variable x 777
+    }
+} -body {
     namespace eval test_ns_1 {
         set x
     }
-} {777}
+} -result {777}
 test namespace-17.7 {Tcl_FindNamespaceVar, relative name found} {
     namespace eval test_ns_1 {
         unset x
@@ -834,8 +922,9 @@ catch {unset x}
 
 catch {unset l}
 catch {rename foo {}}
-test namespace-18.1 {TclResetShadowedCmdRefs, one-level check for command shadowing} {
+test namespace-18.1 {TclResetShadowedCmdRefs, one-level check for command shadowing} -setup {
     catch {namespace delete {*}[namespace children :: test_ns_*]}
+} -body {
     proc foo {} {return "global foo"}
     namespace eval test_ns_1 {
         proc trigger {} {
@@ -849,7 +938,7 @@ test namespace-18.1 {TclResetShadowedCmdRefs, one-level check for command shadow
         proc foo {} {return "foo in test_ns_1"}
     }
     lappend l [test_ns_1::trigger]
-} {{global foo} {foo in test_ns_1}}
+} -result {{global foo} {foo in test_ns_1}}
 test namespace-18.2 {TclResetShadowedCmdRefs, multilevel check for command shadowing} {
     namespace eval test_ns_2 {
         proc foo {} {return "foo in ::test_ns_2"}
@@ -873,22 +962,31 @@ test namespace-18.2 {TclResetShadowedCmdRefs, multilevel check for command shado
 catch {unset l}
 catch {rename foo {}}
 
-test namespace-19.1 {GetNamespaceFromObj, global name found} {
+test namespace-19.1 {GetNamespaceFromObj, global name found} -setup {
     catch {namespace delete {*}[namespace children :: test_ns_*]}
+} -body {
     namespace eval test_ns_1::test_ns_2 {}
     namespace children ::test_ns_1
-} {::test_ns_1::test_ns_2}
-test namespace-19.2 {GetNamespaceFromObj, relative name found} {
+} -result {::test_ns_1::test_ns_2}
+test namespace-19.2 {GetNamespaceFromObj, relative name found} -setup {
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
+    namespace eval test_ns_1::test_ns_2 {}
+} -body {
     namespace eval test_ns_1 {
         namespace children test_ns_2
     }
-} {}
-test namespace-19.3 {GetNamespaceFromObj, name not found} -body {
+} -result {}
+test namespace-19.3 {GetNamespaceFromObj, name not found} -setup {
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
+} -body {
     namespace eval test_ns_1 {
         namespace children test_ns_99
     }
 } -returnCodes error -result {namespace "test_ns_99" not found in "::test_ns_1"}
-test namespace-19.4 {GetNamespaceFromObj, invalidation of cached ns refs} {
+test namespace-19.4 {GetNamespaceFromObj, invalidation of cached ns refs} -setup {
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
+    namespace eval test_ns_1::test_ns_2 {}
+} -body {
     namespace eval test_ns_1 {
         proc foo {} {
             return [namespace children test_ns_2]
@@ -900,7 +998,7 @@ test namespace-19.4 {GetNamespaceFromObj, invalidation of cached ns refs} {
     namespace delete test_ns_1::test_ns_2
     namespace eval test_ns_1::test_ns_2::test_ns_3 {}
     lappend l [test_ns_1::foo]
-} {{} ::test_ns_1::test_ns_2::test_ns_3}
+} -result {{} ::test_ns_1::test_ns_2::test_ns_3}
 
 test namespace-20.1 {Tcl_NamespaceObjCmd, bad subcommand} {
     catch {namespace delete {*}[namespace children :: test_ns_*]}
@@ -913,24 +1011,34 @@ test namespace-20.3 {Tcl_NamespaceObjCmd, abbreviations are okay} {
     namespace ch :: test_ns_*
 } {}
 
-test namespace-21.1 {NamespaceChildrenCmd, no args} {
+test namespace-21.1 {NamespaceChildrenCmd, no args} -setup {
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
+} -body {
+    namespace eval test_ns_1::test_ns_2 {}
+    expr {"::test_ns_1" in [namespace children]}
+} -result {1}
+test namespace-21.2 {NamespaceChildrenCmd, no args} -setup {
     catch {namespace delete {*}[namespace children :: test_ns_*]}
     namespace eval test_ns_1::test_ns_2 {}
-    expr {[string first ::test_ns_1 [namespace children]] != -1}
-} {1}
-test namespace-21.2 {NamespaceChildrenCmd, no args} {
+} -body {
     namespace eval test_ns_1 {
         namespace children
     }
-} {::test_ns_1::test_ns_2}
-test namespace-21.3 {NamespaceChildrenCmd, ns name given} {
+} -result {::test_ns_1::test_ns_2}
+test namespace-21.3 {NamespaceChildrenCmd, ns name given} -setup {
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
+    namespace eval test_ns_1::test_ns_2 {}
+} -body {
     namespace children ::test_ns_1
-} {::test_ns_1::test_ns_2}
-test namespace-21.4 {NamespaceChildrenCmd, ns name given} {
+} -result {::test_ns_1::test_ns_2}
+test namespace-21.4 {NamespaceChildrenCmd, ns name given} -setup {
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
+    namespace eval test_ns_1::test_ns_2 {}
+} -body {
     namespace eval test_ns_1 {
         namespace children test_ns_2
     }
-} {}
+} -result {}
 test namespace-21.5 {NamespaceChildrenCmd, too many args} {
     namespace eval test_ns_1 {
         list [catch {namespace children test_ns_2 xxx yyy} msg] $msg
@@ -940,10 +1048,13 @@ test namespace-21.6 {NamespaceChildrenCmd, glob-style pattern given} {
     namespace eval test_ns_1::test_ns_foo {}
     namespace children test_ns_1 *f*
 } {::test_ns_1::test_ns_foo}
-test namespace-21.7 {NamespaceChildrenCmd, glob-style pattern given} {
+test namespace-21.7 {NamespaceChildrenCmd, glob-style pattern given} -setup {
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
+    namespace eval test_ns_1::test_ns_2 {}
+} -body {
     namespace eval test_ns_1::test_ns_foo {}
     lsort [namespace children test_ns_1 test*]
-} [lsort {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_foo}]
+} -result {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_foo}
 test namespace-21.8 {NamespaceChildrenCmd, trivial pattern starting with ::} {
     namespace eval test_ns_1 {}
     namespace children [namespace current] [fq test_ns_1]
@@ -1038,15 +1149,25 @@ test namespace-25.3 {NamespaceEvalCmd, new namespace} {
     }
     test_ns_1::p
 } {314159}
-test namespace-25.4 {NamespaceEvalCmd, existing namespace} {
+test namespace-25.4 {NamespaceEvalCmd, existing namespace} -setup {
+    namespace eval test_ns_1 {
+        variable v 314159
+        proc p {} {
+            variable v
+            return $v
+        }
+    }
+} -body {
     namespace eval test_ns_1 {
         proc q {} {return [expr {[p]+1}]}
     }
     test_ns_1::q
-} {314160}
-test namespace-25.5 {NamespaceEvalCmd, multiple args} {
+} -result {314160}
+test namespace-25.5 {NamespaceEvalCmd, multiple args} -setup {
+    namespace eval test_ns_1 {variable v 314159}
+} -body {
     namespace eval test_ns_1 "set" "v"
-} {314159}
+} -result {314159}
 test namespace-25.6 {NamespaceEvalCmd, error in eval'd script} {
     list [catch {namespace eval test_ns_1 {xxxx}} msg] $msg $::errorInfo
 } {1 {invalid command name "xxxx"} {invalid command name "xxxx"
@@ -1097,21 +1218,50 @@ test namespace-26.4 {NamespaceExportCmd, one pattern} {
     }
     list [info commands test_ns_2::*] [test_ns_2::cmd1 hello]
 } {::test_ns_2::cmd1 {cmd1: hello}}
-test namespace-26.5 {NamespaceExportCmd, sequence of patterns, patterns accumulate} {
+test namespace-26.5 {NamespaceExportCmd, sequence of patterns, patterns accumulate} -setup {
+    catch {namespace delete {*}[namespace children test_ns_*]}
     namespace eval test_ns_1 {
+        proc cmd1 {args} {return "cmd1: $args"}
+        proc cmd2 {args} {return "cmd2: $args"}
+        proc cmd3 {args} {return "cmd3: $args"}
+        proc cmd4 {args} {return "cmd4: $args"}
         namespace export cmd1 cmd3
     }
+} -body {
     namespace eval test_ns_2 {
         namespace import -force ::test_ns_1::*
     }
     list [lsort [info commands test_ns_2::*]] [test_ns_2::cmd3 hello]
-} [list [lsort {::test_ns_2::cmd1 ::test_ns_2::cmd3}] {cmd3: hello}]
-test namespace-26.6 {NamespaceExportCmd, no patterns means return uniq'ed export list} {
+} -result {{::test_ns_2::cmd1 ::test_ns_2::cmd3} {cmd3: hello}}
+test namespace-26.6 {NamespaceExportCmd, no patterns means return uniq'ed export list} -setup {
+    catch {namespace delete {*}[namespace children test_ns_*]}
+    namespace eval test_ns_1 {
+        proc cmd1 {args} {return "cmd1: $args"}
+        proc cmd2 {args} {return "cmd2: $args"}
+        proc cmd3 {args} {return "cmd3: $args"}
+        proc cmd4 {args} {return "cmd4: $args"}
+        namespace export cmd1 cmd3
+    }
+} -body {
     namespace eval test_ns_1 {
         namespace export
     }
-} {cmd1 cmd3}
-test namespace-26.7 {NamespaceExportCmd, -clear resets export list} {
+} -result {cmd1 cmd3}
+test namespace-26.7 {NamespaceExportCmd, -clear resets export list} -setup {
+    catch {namespace delete {*}[namespace children test_ns_*]}
+    namespace eval test_ns_1 {
+        proc cmd1 {args} {return "cmd1: $args"}
+        proc cmd2 {args} {return "cmd2: $args"}
+        proc cmd3 {args} {return "cmd3: $args"}
+        proc cmd4 {args} {return "cmd4: $args"}
+    }
+} -body {
+    namespace eval test_ns_1 {
+        namespace export cmd1 cmd3
+    }
+    namespace eval test_ns_2 {
+        namespace import ::test_ns_1::*
+    }
     namespace eval test_ns_1 {
         namespace export -clear cmd4
     }
@@ -1119,7 +1269,7 @@ test namespace-26.7 {NamespaceExportCmd, -clear resets export list} {
         namespace import ::test_ns_1::*
     }
     list [lsort [info commands test_ns_2::*]] [test_ns_2::cmd4 hello]
-} [list [lsort {::test_ns_2::cmd4 ::test_ns_2::cmd1 ::test_ns_2::cmd3}] {cmd4: hello}]
+} -result [list [lsort {::test_ns_2::cmd4 ::test_ns_2::cmd1 ::test_ns_2::cmd3}] {cmd4: hello}]
 test namespace-26.8 {NamespaceExportCmd, -clear resets export list} {
     catch {namespace delete foo}
     namespace eval foo {
@@ -1202,14 +1352,23 @@ test namespace-29.4 {NamespaceInscopeCmd, simple case} {
     }
     namespace inscope test_ns_1 cmd
 } {::test_ns_1::cmd: v=747, args=}
-test namespace-29.5 {NamespaceInscopeCmd, has lappend semantics} {
+test namespace-29.5 {NamespaceInscopeCmd, has lappend semantics} -setup {
+    namespace eval test_ns_1 {
+        variable v 747
+        proc cmd {args} {
+            variable v
+            return "[namespace current]::cmd: v=$v, args=$args"
+        }
+    }
+} -body {
     list [namespace inscope test_ns_1 cmd x y z] \
          [namespace eval test_ns_1 [concat cmd [list x y z]]]
-} {{::test_ns_1::cmd: v=747, args=x y z} {::test_ns_1::cmd: v=747, args=x y z}}
-test namespace-29.6 {NamespaceInscopeCmd, 1400572} {
+} -result {{::test_ns_1::cmd: v=747, args=x y z} {::test_ns_1::cmd: v=747, args=x y z}}
+test namespace-29.6 {NamespaceInscopeCmd, 1400572} -setup {
+    namespace eval test_ns_1 {}
+} -body {
     namespace inscope test_ns_1 {info level 0}
-} {namespace inscope test_ns_1 {info level 0}}
-
+} -result {namespace inscope test_ns_1 {info level 0}}
 
 test namespace-30.1 {NamespaceOriginCmd, bad args} {
     catch {namespace delete {*}[namespace children :: test_ns_*]}
@@ -1330,7 +1489,8 @@ test namespace-34.3 {NamespaceWhichCmd, single arg is always command name} {
 test namespace-34.4 {NamespaceWhichCmd, bad args} {
     list [catch {namespace which a b} msg] $msg
 } {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}}
-test namespace-34.5 {NamespaceWhichCmd, command lookup} {
+test namespace-34.5 {NamespaceWhichCmd, command lookup} -setup {
+    catch {namespace delete {*}[namespace children test_ns_*]}
     namespace eval test_ns_1 {
         namespace export cmd*
         variable v1 111
@@ -1343,6 +1503,7 @@ test namespace-34.5 {NamespaceWhichCmd, command lookup} {
         variable v2 222
         proc p {} {}
     }
+} -body {
     namespace eval test_ns_3 {
         namespace import ::test_ns_2::*
         variable v3 333
@@ -1352,26 +1513,59 @@ test namespace-34.5 {NamespaceWhichCmd, command lookup} {
              [namespace which -command ::test_ns_2::cmd2] \
              [catch {namespace which -command ::test_ns_2::noSuchCmd} msg] $msg
     }
-} {::foreach ::test_ns_3::p ::test_ns_3::cmd1 ::test_ns_2::cmd2 0 {}}
-test namespace-34.6 {NamespaceWhichCmd, -command is default} {
+} -result {::foreach ::test_ns_3::p ::test_ns_3::cmd1 ::test_ns_2::cmd2 0 {}}
+test namespace-34.6 {NamespaceWhichCmd, -command is default} -setup {
+    catch {namespace delete {*}[namespace children test_ns_*]}
+    namespace eval test_ns_1 {
+        namespace export cmd*
+        proc cmd1 {args} {return "cmd1: $args"}
+        proc cmd2 {args} {return "cmd2: $args"}
+    }
+    namespace eval test_ns_2 {
+        namespace export *
+        namespace import ::test_ns_1::*
+        proc p {} {}
+    }
+    namespace eval test_ns_3 {
+        namespace import ::test_ns_2::*
+    }
+} -body {
     namespace eval test_ns_3 {
         list [namespace which foreach] \
              [namespace which p] \
              [namespace which cmd1] \
              [namespace which ::test_ns_2::cmd2]
     }
-} {::foreach ::test_ns_3::p ::test_ns_3::cmd1 ::test_ns_2::cmd2}
-test namespace-34.7 {NamespaceWhichCmd, variable lookup} {
+} -result {::foreach ::test_ns_3::p ::test_ns_3::cmd1 ::test_ns_2::cmd2}
+test namespace-34.7 {NamespaceWhichCmd, variable lookup} -setup {
+    catch {namespace delete {*}[namespace children test_ns_*]}
+    namespace eval test_ns_1 {
+        namespace export cmd*
+        proc cmd1 {args} {return "cmd1: $args"}
+        proc cmd2 {args} {return "cmd2: $args"}
+    }
+    namespace eval test_ns_2 {
+        namespace export *
+        namespace import ::test_ns_1::*
+        variable v2 222
+        proc p {} {}
+    }
+    namespace eval test_ns_3 {
+        variable v3 333
+        namespace import ::test_ns_2::*
+    }
+} -body {
     namespace eval test_ns_3 {
         list [namespace which -variable env] \
              [namespace which -variable v3] \
              [namespace which -variable ::test_ns_2::v2] \
              [catch {namespace which -variable ::test_ns_2::noSuchVar} msg] $msg
     }
-} {::env ::test_ns_3::v3 ::test_ns_2::v2 0 {}}
+} -result {::env ::test_ns_3::v3 ::test_ns_2::v2 0 {}}
 
-test namespace-35.1 {FreeNsNameInternalRep, resulting ref count > 0} {
+test namespace-35.1 {FreeNsNameInternalRep, resulting ref count > 0} -setup {
     catch {namespace delete {*}[namespace children :: test_ns_*]}
+} -body {
     namespace eval test_ns_1 {
         proc p {} {
             namespace delete [namespace current]
@@ -1379,7 +1573,7 @@ test namespace-35.1 {FreeNsNameInternalRep, resulting ref count > 0} {
         }
     }
     test_ns_1::p
-} {::test_ns_1}
+} -result {::test_ns_1}
 test namespace-35.2 {FreeNsNameInternalRep, resulting ref count == 0} {
     namespace eval test_ns_1 {
         proc q {} {
-- 
cgit v0.12


From 508b6fc60daf17d4415ead3ad4f9a7cf7bdca1e3 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Sun, 10 Jul 2016 12:45:34 +0000
Subject: Fix to resolver.test

---
 tests/resolver.test | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/tests/resolver.test b/tests/resolver.test
index e73ea50..f3d22e5 100644
--- a/tests/resolver.test
+++ b/tests/resolver.test
@@ -135,6 +135,9 @@ test resolver-1.5 {cmdNameObj sharing vs. cmd resolver: other than global NS} -s
 	    z
 	}
     }
+    namespace eval :: {
+	variable r2 ""
+    }
 } -constraints testinterpresolver -body {
     set r0 [namespace eval ::ns2 {x}]
     set r1 [namespace eval ::ns2 {z}]
-- 
cgit v0.12


From 363cf0a6f1492fa2f03271d3ffda0be8e5ce7f5c Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Sun, 10 Jul 2016 14:14:28 +0000
Subject: Fixes to namespace-old.test

---
 tests/namespace-old.test | 169 +++++++++++++++++++++++++++++++++++++++--------
 1 file changed, 140 insertions(+), 29 deletions(-)

diff --git a/tests/namespace-old.test b/tests/namespace-old.test
index 1d8ba31..1d6a805 100644
--- a/tests/namespace-old.test
+++ b/tests/namespace-old.test
@@ -57,6 +57,12 @@ test namespace-old-1.9 {add elements to a namespace} {
         }
     }
 } {}
+namespace eval test_ns_simple {
+    variable test_ns_x 0
+    proc test {test_ns_x} {
+	return "test: $test_ns_x"
+    }
+}
 test namespace-old-1.10 {commands in a namespace} {
     namespace eval test_ns_simple { info commands [namespace current]::*}
 } {::test_ns_simple::test}
@@ -74,6 +80,12 @@ test namespace-old-1.13 {add to an existing namespace} {
         }
     }
 } ""
+namespace eval test_ns_simple {
+    variable test_ns_y 123
+    proc _backdoor {cmd} {
+	eval $cmd
+    }
+}
 test namespace-old-1.14 {commands in a namespace} {
     lsort [namespace eval test_ns_simple {info commands [namespace current]::*}]
 } {::test_ns_simple::_backdoor ::test_ns_simple::test}
@@ -128,6 +140,8 @@ test namespace-old-1.26 {namespace qualifiers are okay after $'s} {
 test namespace-old-1.27 {can create commands with null names} {
     proc test_ns_simple:: {args} {return $args}
 } {}
+# Redeclare; later tests depend on it
+proc test_ns_simple:: {args} {return $args}
 
 # -----------------------------------------------------------------------
 # TEST: using "info" in namespace contexts
@@ -212,6 +226,11 @@ test namespace-old-4.3 {command "namespace delete" doesn't support patterns} {
     }
     list [catch $cmd msg] $msg
 } {1 {unknown namespace "ns*" in namespace delete command}}
+namespace eval test_ns_delete {
+    namespace eval ns1 {}
+    namespace eval ns2 {}
+    namespace eval another {}
+}
 test namespace-old-4.4 {command "namespace delete" handles multiple args} {
     set cmd {
         namespace eval test_ns_delete {
@@ -256,6 +275,24 @@ test namespace-old-5.3 {namespace qualifiers work in namespace command} {
          [namespace eval test_ns_hier1::test_ns_hier2 {namespace current}] \
          [namespace eval ::test_ns_hier1::test_ns_hier2 {namespace current}]
 } {::test_ns_hier1 ::test_ns_hier1::test_ns_hier2 ::test_ns_hier1::test_ns_hier2}
+set ::test_ns_var_global "var in ::"
+proc test_ns_cmd_global {} {return "cmd in ::"}
+namespace eval test_ns_hier1 {
+    variable test_ns_var_hier1 "particular to hier1"
+    proc test_ns_cmd_hier1 {} {return "particular to hier1"}
+    variable test_ns_level 1
+    proc test_ns_show {} {return "[namespace current]: 1"}
+    namespace eval test_ns_hier2 {
+	variable test_ns_var_hier2 "particular to hier2"
+	proc test_ns_cmd_hier2 {} {return "particular to hier2"}
+	variable test_ns_level 2
+        proc test_ns_show {} {return "[namespace current]: 2"}
+	namespace eval test_ns_hier3a {}
+	namespace eval test_ns_hier3b {}
+    }
+    namespace eval test_ns_hier2a {}
+    namespace eval test_ns_hier2b {}
+}
 test namespace-old-5.4 {nested namespaces can access global namespace} {
     list [namespace eval test_ns_hier1 {set test_ns_var_global}] \
          [namespace eval test_ns_hier1 {test_ns_cmd_global}] \
@@ -331,16 +368,12 @@ test namespace-old-5.21 {querying namespace parent for explicit namespace} {
 # -----------------------------------------------------------------------
 # TEST: name resolution and caching
 # -----------------------------------------------------------------------
+set trigger {namespace eval test_ns_cache2 {namespace current}}
+set trigger2 {namespace eval test_ns_cache2::test_ns_cache3 {namespace current}}
 test namespace-old-6.1 {relative ns names only looked up in current ns} {
     namespace eval test_ns_cache1 {}
     namespace eval test_ns_cache2 {}
     namespace eval test_ns_cache2::test_ns_cache3 {}
-    set trigger {
-        namespace eval test_ns_cache2 {namespace current}
-    }
-    set trigger2 {
-        namespace eval test_ns_cache2::test_ns_cache3 {namespace current}
-    }
     list [namespace eval test_ns_cache1 $trigger] \
          [namespace eval test_ns_cache1 $trigger2]
 } {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3}
@@ -354,20 +387,19 @@ test namespace-old-6.3 {relative ns names only looked up in current ns} {
     list [namespace eval test_ns_cache1 $trigger] \
          [namespace eval test_ns_cache1 $trigger2]
 } {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3}
+namespace eval test_ns_cache1::test_ns_cache2 {}
 test namespace-old-6.4 {relative ns names only looked up in current ns} {
     namespace delete test_ns_cache1::test_ns_cache2
     list [namespace eval test_ns_cache1 $trigger] \
          [namespace eval test_ns_cache1 $trigger2]
 } {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3}
+namespace eval test_ns_cache1 {
+    proc trigger {} {test_ns_cache_cmd}
+}
 test namespace-old-6.5 {define test commands} {
     proc test_ns_cache_cmd {} {
         return "global version"
     }
-    namespace eval test_ns_cache1 {
-        proc trigger {} {
-            test_ns_cache_cmd
-        }
-    }
     test_ns_cache1::trigger
 } {global version}
 test namespace-old-6.6 {one-level check for command shadowing} {
@@ -376,24 +408,36 @@ test namespace-old-6.6 {one-level check for command shadowing} {
     }
     test_ns_cache1::trigger
 } {cache1 version}
-test namespace-old-6.7 {renaming commands changes command epoch} {
-    namespace eval test_ns_cache1 {
-        rename test_ns_cache_cmd test_ns_new
+proc test_ns_cache_cmd {} {
+    return "global version"
+}
+test namespace-old-6.7 {renaming commands changes command epoch} -setup {
+    proc test_ns_cache1::test_ns_cache_cmd {} {
+        return "cache1 version"
     }
-    test_ns_cache1::trigger
-} {global version}
-test namespace-old-6.8 {renaming back handles shadowing} {
-    namespace eval test_ns_cache1 {
-        rename test_ns_new test_ns_cache_cmd
+} -body {
+    list [test_ns_cache1::trigger] \
+	[namespace eval test_ns_cache1 {rename test_ns_cache_cmd test_ns_new}]\
+	[test_ns_cache1::trigger]
+} -result {{cache1 version} {} {global version}}
+test namespace-old-6.8 {renaming back handles shadowing} -setup {
+    proc test_ns_cache1::test_ns_new {} {
+        return "cache1 version"
     }
-    test_ns_cache1::trigger
-} {cache1 version}
-test namespace-old-6.9 {deleting commands changes command epoch} {
-    namespace eval test_ns_cache1 {
-        rename test_ns_cache_cmd ""
+} -body {
+    list [test_ns_cache1::trigger] \
+	[namespace eval test_ns_cache1 {rename test_ns_new test_ns_cache_cmd}]\
+	[test_ns_cache1::trigger]
+} -result {{global version} {} {cache1 version}}
+test namespace-old-6.9 {deleting commands changes command epoch} -setup {
+    proc test_ns_cache1::test_ns_cache_cmd {} {
+        return "cache1 version"
     }
-    test_ns_cache1::trigger
-} {global version}
+} -body {
+    list [test_ns_cache1::trigger] \
+	[namespace eval test_ns_cache1 {rename test_ns_cache_cmd ""}] \
+	[test_ns_cache1::trigger]
+} -result {{cache1 version} {} {global version}}
 test namespace-old-6.10 {define test namespaces} {
     namespace eval test_ns_cache2 {
         proc test_ns_cache_cmd {} {
@@ -412,6 +456,12 @@ test namespace-old-6.10 {define test namespaces} {
     }
     list [test_ns_cache1::trigger] [test_ns_cache1::test_ns_cache2::trigger]
 } {{global cache2 version} {global version}}
+namespace eval test_ns_cache1 {
+    proc trigger {} { test_ns_cache2::test_ns_cache_cmd }
+    namespace eval test_ns_cache2 {
+	proc trigger {} { test_ns_cache_cmd }
+    }
+}
 test namespace-old-6.11 {commands affect all parent namespaces} {
     proc test_ns_cache1::test_ns_cache2::test_ns_cache_cmd {} {
         return "cache2 version"
@@ -423,18 +473,22 @@ test namespace-old-6.12 {define test variables} {
     set trigger {set test_ns_cache_var}
     namespace eval test_ns_cache1 $trigger
 } {global version}
+    set trigger {set test_ns_cache_var}
 test namespace-old-6.13 {one-level check for variable shadowing} {
     namespace eval test_ns_cache1 {
         variable test_ns_cache_var "cache1 version"
     }
     namespace eval test_ns_cache1 $trigger
 } {cache1 version}
+variable ::test_ns_cache_var "global version"
 test namespace-old-6.14 {deleting variables changes variable epoch} {
     namespace eval test_ns_cache1 {
-        unset test_ns_cache_var
+        variable test_ns_cache_var "cache1 version"
     }
-    namespace eval test_ns_cache1 $trigger
-} {global version}
+    list [namespace eval test_ns_cache1 $trigger] \
+	[namespace eval test_ns_cache1 {unset test_ns_cache_var}] \
+	[namespace eval test_ns_cache1 $trigger]
+} {{cache1 version} {} {global version}}
 test namespace-old-6.15 {define test namespaces} {
     namespace eval test_ns_cache2 {
         variable test_ns_cache_var "global cache2 version"
@@ -443,6 +497,7 @@ test namespace-old-6.15 {define test namespaces} {
     list [namespace eval test_ns_cache1 $trigger2] \
          [namespace eval test_ns_cache1::test_ns_cache2 $trigger]
 } {{global cache2 version} {global version}}
+set trigger2 {set test_ns_cache2::test_ns_cache_var}
 test namespace-old-6.16 {public variables affect all parent namespaces} {
     variable test_ns_cache1::test_ns_cache2::test_ns_cache_var "cache2 version"
     list [namespace eval test_ns_cache1 $trigger2] \
@@ -467,6 +522,7 @@ test namespace-old-6.19 {querying:  namespace which -command} {
 test namespace-old-6.20 {command "namespace which" may not find commands} {
     namespace eval test_ns_cache1 {namespace which -command xyzzy}
 } {}
+variable test_ns_cache1::test_ns_cache2::test_ns_cache_var "cache2 version"
 test namespace-old-6.21 {querying:  namespace which -variable} {
     namespace eval test_ns_cache1::test_ns_cache2 {
         namespace which -variable test_ns_cache_var
@@ -493,6 +549,18 @@ test namespace-old-7.1 {define test namespace} {
         }
     }
 } {}
+namespace eval test_ns_uplevel {
+    variable x 0
+    variable y 1
+    proc show_vars {num} {
+	return [uplevel $num {info vars}]
+    }
+    proc test_uplevel {num} {
+	set a 0
+	set b 1
+	namespace eval ::test_ns_uplevel " return \[show_vars $num\] "
+    }
+}
 test namespace-old-7.2 {uplevel can access namespace call frame} {
     list [expr {"x" in [test_ns_uplevel::test_uplevel 1]}] \
          [expr {"y" in [test_ns_uplevel::test_uplevel 1]}]
@@ -526,6 +594,17 @@ test namespace-old-7.8 {namespaces are included in the call stack} {
         }
     }
 } {}
+namespace eval test_ns_upvar {
+    variable scope "test_ns_upvar"
+    proc show_val {var num} {
+	upvar $num $var x
+	return $x
+    }
+    proc test_upvar {num} {
+	set scope "test_ns_upvar::test_upvar"
+	namespace eval ::test_ns_upvar " return \[show_val scope $num\] "
+    }
+}
 test namespace-old-7.9 {upvar can access namespace call frame} {
     test_ns_upvar::test_upvar 1
 } {test_ns_upvar}
@@ -581,6 +660,15 @@ test namespace-old-9.3 {define test namespaces for import} {
     }
     lsort [info commands test_ns_export::*]
 } {::test_ns_export::cmd1 ::test_ns_export::cmd2 ::test_ns_export::cmd3 ::test_ns_export::cmd4 ::test_ns_export::cmd5 ::test_ns_export::cmd6}
+namespace eval test_ns_export {
+    namespace export cmd1 cmd2 cmd3
+    proc cmd1 {args} {return "cmd1: $args"}
+    proc cmd2 {args} {return "cmd2: $args"}
+    proc cmd3 {args} {return "cmd3: $args"}
+    proc cmd4 {args} {return "cmd4: $args"}
+    proc cmd5 {args} {return "cmd5: $args"}
+    proc cmd6 {args} {return "cmd6: $args"}
+}
 test namespace-old-9.4 {check export status} {
     set x ""
     namespace eval test_ns_import {
@@ -592,6 +680,10 @@ test namespace-old-9.4 {check export status} {
     }
     set x
 } {::test_ns_import::cmd1 ::test_ns_import::cmd2 ::test_ns_import::cmd3}
+namespace eval test_ns_import {
+    namespace export cmd1 cmd2
+    namespace import ::test_ns_export::*
+}
 test namespace-old-9.5 {empty import list in "namespace import" command} {
     namespace eval test_ns_import_empty {
 	namespace import ::test_ns_export::*
@@ -615,6 +707,7 @@ test namespace-old-9.8 {only exported commands are imported} {
     namespace import test_ns_import::cmd*
     set x [lsort [info commands cmd*]]
 } {cmd1 cmd2}
+namespace import test_ns_import::cmd*
 test namespace-old-9.9 {imported commands work just the same as original} {
     list [cmd1 test 1 2 3] [test_ns_import::cmd1 test 4 5 6]
 } {{cmd1: test 1 2 3} {cmd1: test 4 5 6}}
@@ -629,10 +722,19 @@ test namespace-old-9.10 {commands can be imported from many namespaces} {
     namespace import test_ns_import2::*
     lsort [concat [info commands cmd*] [info commands ncmd*]]
 } {cmd1 cmd2 ncmd ncmd1 ncmd2}
+namespace eval test_ns_import2 {
+    namespace export ncmd ncmd1 ncmd2
+    proc ncmd  {args} {return "ncmd: $args"}
+    proc ncmd1 {args} {return "ncmd1: $args"}
+    proc ncmd2 {args} {return "ncmd2: $args"}
+    proc ncmd3 {args} {return "ncmd3: $args"}
+}
+namespace import test_ns_import2::*
 test namespace-old-9.11 {imported commands can be removed by deleting them} {
     rename cmd1 ""
     lsort [concat [info commands cmd*] [info commands ncmd*]]
 } {cmd2 ncmd ncmd1 ncmd2}
+catch { rename cmd1 "" }
 test namespace-old-9.12 {command "namespace forget" checks for valid namespaces} {
     list [catch {namespace forget xyzzy::*} msg] $msg
 } {1 {unknown namespace in namespace forget pattern "xyzzy::*"}}
@@ -653,6 +755,7 @@ test namespace-old-9.15 {existing commands can't be overwritten} {
          [cmd1 3 5]
 } {1 {can't import command "cmd1": already exists} 8}
 test namespace-old-9.16 {use "-force" option to override existing commands} {
+    proc cmd1 {x y} { return [expr $x+$y] }
     list [cmd1 3 5] \
          [namespace import -force test_ns_import::cmd?] \
          [cmd1 3 5]
@@ -711,10 +814,18 @@ test namespace-old-10.6 {with many args, each "scope" adds new args} {
     set sval [namespace eval test_ns_inscope {namespace code {one two}}]
     namespace code "$sval three"
 } {::namespace inscope ::test_ns_inscope {one two} three}
+namespace eval test_ns_inscope {
+    proc show {args} {
+	return "show: $args"
+    }
+}
 test namespace-old-10.7 {scoped commands work with eval} {
     set cref [namespace eval test_ns_inscope {namespace code show}]
     list [eval $cref "a" "b c" "d e f"]
 } {{show: a b c d e f}}
+namespace eval test_ns_inscope {
+    variable x "x-value"
+}
 test namespace-old-10.8 {scoped commands execute in namespace context} {
     set cref [namespace eval test_ns_inscope {
         namespace code {set x "some new value"}
-- 
cgit v0.12


From 68432b7ed1a1020765f87ce26588d4b4f6962274 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Sun, 10 Jul 2016 19:28:57 +0000
Subject: [96fe2f1cc7] Plug memory leak.

---
 generic/tclExecute.c | 1 +
 1 file changed, 1 insertion(+)

diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 52865e6..c0cbd9e 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -3168,6 +3168,7 @@ TEBCresume(
 	    Tcl_ListObjAppendElement(NULL, copyPtr, objPtr);
 	    Tcl_ListObjReplace(NULL, copyPtr, LIST_MAX, 0, 
 		    objc - opnd, objv + opnd);
+	    Tcl_DecrRefCount(objPtr);
 	    objPtr = copyPtr;
 	}
 
-- 
cgit v0.12