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.37.2.1 2005/07/12 20:37:12 kennykb Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
testConstraint testcmdtrace [llength [info commands testcmdtrace]]
|
|
|
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.37.2.2 2005/08/02 18:16:43 dgp Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
testConstraint testcmdtrace [llength [info commands testcmdtrace]]
|
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
|
proc foo {} {set x {}}
proc bar args {trace remove execution foo enterstep soom}
trace add execution foo enterstep soom
trace add execution foo enterstep bar
foo
} {}
test trace-35.1 {527164: Keep -errorinfo of traces} -setup {
unset -nocomplain x y
} -body {
trace add variable x write {error foo;#}
trace add variable y write {set x 2;#}
list [catch {set y 1} msg opts] $msg [dict get $opts -errorinfo]
} -cleanup {
|
>
>
>
>
>
>
>
>
>
>
>
|
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
|
proc foo {} {set x {}}
proc bar args {trace remove execution foo enterstep soom}
trace add execution foo enterstep soom
trace add execution foo enterstep bar
foo
} {}
test trace-34.4 {Bug 1047286} {
variable x notrace
proc callback {old - -} {
variable x "$old exists: [namespace which -command $old]"
}
namespace eval ::foo {proc bar {} {}}
trace add command ::foo::bar delete [namespace code callback]
namespace delete ::foo
set x
} {::foo::bar exists: ::foo::bar}
test trace-35.1 {527164: Keep -errorinfo of traces} -setup {
unset -nocomplain x y
} -body {
trace add variable x write {error foo;#}
trace add variable y write {set x 2;#}
list [catch {set y 1} msg opts] $msg [dict get $opts -errorinfo]
} -cleanup {
|