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.26 2003/02/03 20:16:54 kennykb Exp $
# RCS: @(#) $Id: trace.test,v 1.27 2003/03/27 13:19:15 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
proc traceScalar {name1 name2 op} {
|
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
|
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
|
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
|
list [catch {trace variable x y z w} msg] $msg
} [list 1 "wrong # args: should be \"trace variable name ops command\""]
test trace-14.11 {trace command, "trace variable" errors} {
list [catch {trace variable x y z} msg] $msg
} [list 1 "bad operations \"y\": should be one or more of rwua"]
test trace-14.9 {trace command ("remove variable" option)} {
test trace-14.12 {trace command ("remove variable" option)} {
catch {unset x}
set info {}
trace add variable x write traceProc
trace remove variable x write traceProc
} {}
test trace-14.10 {trace command ("remove variable" option)} {
test trace-14.13 {trace command ("remove variable" option)} {
catch {unset x}
set info {}
trace add variable x write traceProc
trace remove variable x write traceProc
set x 12345
set info
} {}
test trace-14.11 {trace command ("remove variable" option)} {
test trace-14.14 {trace command ("remove variable" option)} {
catch {unset x}
set info {}
trace add variable x write {traceTag 1}
trace add variable x write traceProc
trace add variable x write {traceTag 2}
set x yy
trace remove variable x write traceProc
set x 12345
trace remove variable x write {traceTag 1}
set x foo
trace remove variable x write {traceTag 2}
set x gorp
set info
} {2 x {} write 1 2 1 2}
test trace-14.12 {trace command ("remove variable" option)} {
test trace-14.15 {trace command ("remove variable" option)} {
catch {unset x}
set info {}
trace add variable x write {traceTag 1}
trace remove variable x write non_existent
set x 12345
set info
} {1}
test trace-14.15 {trace command ("info variable" option)} {
test trace-14.16 {trace command ("info variable" option)} {
catch {unset x}
trace add variable x write {traceTag 1}
trace add variable x write traceProc
trace add variable x write {traceTag 2}
trace info variable x
} {{write {traceTag 2}} {write traceProc} {write {traceTag 1}}}
test trace-14.16 {trace command ("info variable" option)} {
test trace-14.17 {trace command ("info variable" option)} {
catch {unset x}
trace info variable x
} {}
test trace-14.17 {trace command ("info variable" option)} {
test trace-14.18 {trace command ("info variable" option)} {
catch {unset x}
trace info variable x(0)
} {}
test trace-14.18 {trace command ("info variable" option)} {
test trace-14.19 {trace command ("info variable" option)} {
catch {unset x}
set x 44
trace info variable x(0)
} {}
test trace-14.19 {trace command ("info variable" option)} {
test trace-14.20 {trace command ("info variable" option)} {
catch {unset x}
set x 44
trace add variable x write {traceTag 1}
proc check {} {global x; trace info variable x}
check
} {{write {traceTag 1}}}
|
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
|
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
|
-
+
-
+
|
# Delete arrays when done, so they can be re-used as scalars
# elsewhere.
catch {unset x}
catch {unset y}
test trace-18.2 {trace add command (command existence)} {
test trace-18.3 {trace add command (command existence)} {
# Just in case!
catch {rename nosuchname ""}
list [catch {trace add command nosuchname rename traceCommand} msg] $msg
} {1 {unknown command "nosuchname"}}
test trace-18.3 {trace add command (command existence in ns)} {
test trace-18.4 {trace add command (command existence in ns)} {
list [catch {trace add command nosuchns::nosuchname rename traceCommand} msg] $msg
} {1 {unknown command "nosuchns::nosuchname"}}
test trace-19.1 {trace add command (rename option)} {
proc foo {} {}
catch {rename bar {}}
|
2101
2102
2103
2104
2105
2106
2107
2108
|
2101
2102
2103
2104
2105
2106
2107
|
-
|
# Unset the varaible when done
catch {unset info}
# cleanup
::tcltest::cleanupTests
return
|