Attachment "2023112.patch" to
ticket [2023112fff]
added by
dgp
2008-08-03 11:54:14.
Index: generic/tclExecute.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclExecute.c,v
retrieving revision 1.393
diff -u -u -r1.393 tclExecute.c
--- generic/tclExecute.c 31 Jul 2008 14:43:44 -0000 1.393
+++ generic/tclExecute.c 3 Aug 2008 04:51:04 -0000
@@ -2259,6 +2259,16 @@
CACHE_STACK_INFO();
if (result != TCL_OK) {
cleanup = 0;
+ if (result == TCL_ERROR) {
+ /*
+ * Tcl_EvalEx already did the task of logging
+ * the error to the stack trace for us, so set
+ * a flag to prevent the TEBC exception handling
+ * machinery from trying to do it again. Issue
+ * exposed by [Tcl Bug 2023112].
+ */
+ iPtr->flags |= ERR_ALREADY_LOGGED;
+ }
goto processExceptionReturn;
}
opnd = TclGetUInt4AtPtr(pc+1);
Index: tests/oo.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/oo.test,v
retrieving revision 1.9
diff -u -u -r1.9 oo.test
--- tests/oo.test 25 Jul 2008 22:11:21 -0000 1.9
+++ tests/oo.test 3 Aug 2008 04:51:04 -0000
@@ -15,6 +15,7 @@
namespace import -force ::tcltest::*
}
+testConstraint testcmdtrace [llength [info commands testcmdtrace]]
testConstraint memory [llength [info commands memory]]
if {[testConstraint memory]} {
proc getbytes {} {
@@ -1352,6 +1353,18 @@
(class "::cls" method "eval" line 1)
invoked from within
"obj eval {error bar}"}}
+test oo-18.6 {Bug 2023112} -constraints testcmdtrace -setup {
+ oo::class create sneeble {}
+ sneeble destroy
+} -body {
+ testcmdtrace tracetest {} ;# Bump compile epoch
+ list [catch {oo::class create foo {error bar}} msg] $msg $errorInfo
+} -result {1 bar {bar
+ while executing
+"error bar"
+ (in definition script for object "::foo" line 1)
+ invoked from within
+"oo::class create foo {error bar}"}}
test oo-19.1 {OO: varname method} -setup {
oo::object create inst
