* generic/tclBasic.c (Tcl_AddObjErrorInfo): More re-organization

        * generic/tclCmdAH.c (Tcl_ErrorObjCmd):     of the management of
        * generic/tclCmdMZ.c (TclProcessReturn):    the errorCode value.
        * tests/error.test (error-6.4-9):

        * generic/tclNamespace.c (TclTeardownNamespace): Tcl_Obj-ified
        * tests/namespace.test (namespace-8.5,6):       the save/restore
        of ::errorInfo and ::errorCode during global namespace teardown.
        Revised the comment to clarify why this is done, and added tests
        that will fail if this is not done.

        * generic/tclResult.c (TclTransferResult):      Added safety
        checks so that unexpected undefined ::errorInfo or ::errorCode
        will not lead to a segfault.

        * generic/tclTrace.c (TclCallVarTraces):     Save/restore the flag
        * tests/var.test (var-16.1):    values that define part of the
        interpreter state during variable traces.  [Bug 10381021].

3 files changed, 58 insertions, 3 deletions

diff --git a/tests/error.test b/tests/error.test
index 3773df5..0cca88f 100644
--- a/tests/error.test
+++ b/tests/error.test
@@ -11,7 +11,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: error.test,v 1.11 2004/09/20 15:52:05 dgp Exp $
+# RCS: @(#) $Id: error.test,v 1.12 2004/09/30 23:06:49 dgp Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -185,6 +185,36 @@ test error-6.3 {catch must reset error state} {
     catch {error outer [catch set]}
     list $errorCode $errorInfo
 } {NONE 1}
+test error-6.4 {catch must reset error state} {
+    catch {error [catch {error foo bar baz}] 1}
+    list $errorCode $errorInfo
+} {NONE 1}
+test error-6.5 {catch must reset error state} {
+    catch {error [catch {return -level 0 -code error -errorcode BUG}] 1}
+    list $errorCode $errorInfo
+} {NONE 1}
+test error-6.6 {catch must reset error state} {
+    catch {return -level 0 -code error -errorinfo [catch {error foo bar baz}]}
+    list $errorCode $errorInfo
+} {NONE 1}
+test error-6.7 {catch must reset error state} {
+    proc foo {} {
+	return -code error -errorinfo [catch {error foo bar baz}]
+    }
+    catch foo
+    list $errorCode
+} {NONE}
+test error-6.8 {catch must reset error state} {
+    catch {return -level 0 -code error [catch {error foo bar baz}]}
+    list $errorCode
+} {NONE}
+test error-6.9 {catch must reset error state} {
+    proc foo {} {
+	return -code error [catch {error foo bar baz}]
+    }
+    catch foo
+    list $errorCode
+} {NONE}
 
 # cleanup
 catch {rename p ""}
diff --git a/tests/namespace.test b/tests/namespace.test
index e11cfc6..2765f61 100644
--- a/tests/namespace.test
+++ b/tests/namespace.test
@@ -11,7 +11,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: namespace.test,v 1.38 2004/09/24 01:14:43 dgp Exp $
+# RCS: @(#) $Id: namespace.test,v 1.39 2004/09/30 23:06:49 dgp Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -193,6 +193,24 @@ test namespace-8.4 {TclTeardownNamespace, cmds imported from deleted ns go away}
          [namespace delete test_ns_export] \
          [info commands test_ns_import::*]
 } [list [lsort {::test_ns_import::p ::test_ns_import::cmd1 ::test_ns_import::cmd2}] {} ::test_ns_import::p]
+test namespace-8.5 {TclTeardownNamespace: preserve errorInfo; errorCode values} {
+    interp create slave
+    slave eval {trace add execution error leave {namespace delete :: ;#}}
+    catch {slave eval error foo bar baz}
+    interp delete slave
+    set ::errorInfo
+} {bar
+    invoked from within
+"slave eval error foo bar baz"}
+test namespace-8.6 {TclTeardownNamespace: preserve errorInfo; errorCode values} {
+    interp create slave 
+    slave eval {trace add variable errorCode write {namespace delete :: ;#}}
+    catch {slave eval error foo bar baz}
+    interp delete slave
+    set ::errorInfo
+} {bar
+    invoked from within
+"slave eval error foo bar baz"}
 
 test namespace-9.1 {Tcl_Import, empty import pattern} {
     catch {namespace delete {expand}[namespace children :: test_ns_*]}
diff --git a/tests/var.test b/tests/var.test
index df6b491..df9d553 100644
--- a/tests/var.test
+++ b/tests/var.test
@@ -14,7 +14,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: var.test,v 1.25 2004/05/19 20:33:11 dkf Exp $
+# RCS: @(#) $Id: var.test,v 1.26 2004/09/30 23:06:49 dgp Exp $
 #
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
@@ -695,6 +695,13 @@ test var-15.1 {segfault in [unset], [Bug 735335]} {
 } {}
 
 
+test var-16.1 {CallVarTraces: save/restore interp error state} {
+    trace add variable errorCode write { ;#}
+    catch {error foo bar baz}
+    trace remove variable errorCode write { ;#}
+    set errorInfo
+} bar
+
 catch {namespace delete ns}
 catch {unset arr}
 catch {unset v}