1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
|
-
+
|
# Commands covered: trace
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands. Sourcing this file into Tcl runs the tests and
# generates output for errors. No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# 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.30 2003/09/24 02:07:52 dgp Exp $
# RCS: @(#) $Id: trace.test,v 1.31 2003/09/24 12:56:17 vincentdarley Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
testConstraint testcmdtrace [llength [info commands testcmdtrace]]
|
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
|
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
|
-
+
+
|
foo {if {[catch {bar}]} {
return "error"
} else {
return "ok"
}} 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 {}
proc foo {} {
if {[catch {bar}]} {
return "error"
|
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
|
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
|
-
+
-
+
-
-
-
-
+
+
+
+
-
-
-
-
+
+
+
+
|
# With the trace active
lappend res [foo]
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
foo {return -code error msg} 2 msg leavestep
foo bar 1 msg leavestep
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} {
set info {}
proc foo {args} { set a 1 }
trace add execution foo {enter enterstep leave leavestep} \
[list traceExecute foo]
|