summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2003-09-29 22:03:43 (GMT)
committerdgp <dgp@users.sourceforge.net>2003-09-29 22:03:43 (GMT)
commit727cc7ed58601550160c4b3dbc91bec67fec705f (patch)
tree2317435f500aeefe27f8bf5723cfec0c8f8b64e2 /tests
parentd6fa269907f590d521bdbc7aa2c2225f3beb3526 (diff)
downloadtcl-727cc7ed58601550160c4b3dbc91bec67fec705f.zip
tcl-727cc7ed58601550160c4b3dbc91bec67fec705f.tar.gz
tcl-727cc7ed58601550160c4b3dbc91bec67fec705f.tar.bz2
* generic/tclBasic.c (CallCommandTraces): Added safety bit
* tests/trace.test: masking to prevent any of the bit values TCL_TRACE_*_EXEC from leaking into the flags field of any Command struct. This does not fix [Bug 811483] but helps to contain some of its worst symptoms. Also backported the corrections to test trace-28.4 from Vince Darley.
Diffstat (limited to 'tests')
-rw-r--r--tests/trace.test29
1 files changed, 16 insertions, 13 deletions
diff --git a/tests/trace.test b/tests/trace.test
index 4e010e9..6475aed 100644
--- a/tests/trace.test
+++ b/tests/trace.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: trace.test,v 1.26.2.2 2003/09/24 02:17:10 dgp Exp $
+# RCS: @(#) $Id: trace.test,v 1.26.2.3 2003/09/29 22:03:44 dgp Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -1980,9 +1980,10 @@ foo {if {[catch {bar}]} {
}} 2 error leavestep
foo foo 0 error leave}}
-test trace-28.4 {exec traces in slave with 'return -code error'} {knownBug} {
+test trace-28.4 {exec traces in slave with 'return -code error'} {
interp create slave
interp alias slave traceExecute {} traceExecute
+ set info {}
set res [interp eval slave {
set info {}
set res {}
@@ -2009,16 +2010,16 @@ test trace-28.4 {exec traces in slave with 'return -code error'} {knownBug} {
trace remove execution foo {enter enterstep leave leavestep} \
[list traceExecute foo]
- list $res [join $info \n]
+ list $res
}]
interp delete slave
- set res
+ lappend res [join $info \n]
} {{error error} {foo foo enter
foo {if {[catch {bar}]} {
- return "error"
- } else {
- return "ok"
- }} enterstep
+ return "error"
+ } else {
+ return "ok"
+ }} enterstep
foo {catch bar} enterstep
foo bar enterstep
foo {return -code error msg} enterstep
@@ -2028,10 +2029,10 @@ foo {catch bar} 0 1 leavestep
foo {return error} enterstep
foo {return error} 2 error leavestep
foo {if {[catch {bar}]} {
- return "error"
- } else {
- return "ok"
- }} 2 error leavestep
+ return "error"
+ } else {
+ return "ok"
+ }} 2 error leavestep
foo foo 0 error leave}}
test trace-28.5 {exec traces} {
@@ -2119,7 +2120,9 @@ test trace-31.2 {command and execution traces shared struct} {
set result
} [list [list enter foo]]
-test trace-32.1 {mystery memory corruption} knownBug {
+test trace-32.1 {
+ TraceCommandInfo refcount decr in TraceCommandProc w/o loss of reference
+} {
# Tcl Bug 811483
proc foo {} {}
trace add command foo delete foo