Symaptic: os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/trace.test@260cb5ec6c19 (annotated)

sl@0	1	# Commands covered: trace
sl@0	2	#
sl@0	3	# This file contains a collection of tests for one or more of the Tcl
sl@0	4	# built-in commands. Sourcing this file into Tcl runs the tests and
sl@0	5	# generates output for errors. No output means no errors were found.
sl@0	6	#
sl@0	7	# Copyright (c) 1991-1993 The Regents of the University of California.
sl@0	8	# Copyright (c) 1994 Sun Microsystems, Inc.
sl@0	9	# Copyright (c) 1998-1999 by Scriptics Corporation.
sl@0	10	#
sl@0	11	# See the file "license.terms" for information on usage and redistribution
sl@0	12	# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
sl@0	13	#
sl@0	14	# RCS: @(#) $Id: trace.test,v 1.26.2.17 2006/11/04 01:37:56 msofer Exp $
sl@0	15
sl@0	16	if {[lsearch [namespace children] ::tcltest] == -1} {
sl@0	17	package require tcltest
sl@0	18	namespace import -force ::tcltest::*
sl@0	19	}
sl@0	20
sl@0	21	# Used for constraining memory leak tests
sl@0	22	testConstraint memory [llength [info commands memory]]
sl@0	23
sl@0	24	testConstraint testevalobjv [llength [info commands testevalobjv]]
sl@0	25
sl@0	26	proc getbytes {} {
sl@0	27	set lines [split [memory info] "\n"]
sl@0	28	lindex [lindex $lines 3] 3
sl@0	29	}
sl@0	30
sl@0	31	proc traceScalar {name1 name2 op} {
sl@0	32	global info
sl@0	33	set info [list $name1 $name2 $op [catch {uplevel set $name1} msg] $msg]
sl@0	34	}
sl@0	35	proc traceScalarAppend {name1 name2 op} {
sl@0	36	global info
sl@0	37	lappend info $name1 $name2 $op [catch {uplevel set $name1} msg] $msg
sl@0	38	}
sl@0	39	proc traceArray {name1 name2 op} {
sl@0	40	global info
sl@0	41	set info [list $name1 $name2 $op [catch {uplevel set [set name1]($name2)} msg] $msg]
sl@0	42	}
sl@0	43	proc traceArray2 {name1 name2 op} {
sl@0	44	global info
sl@0	45	set info [list $name1 $name2 $op]
sl@0	46	}
sl@0	47	proc traceProc {name1 name2 op} {
sl@0	48	global info
sl@0	49	set info [concat $info [list $name1 $name2 $op]]
sl@0	50	}
sl@0	51	proc traceTag {tag args} {
sl@0	52	global info
sl@0	53	set info [concat $info $tag]
sl@0	54	}
sl@0	55	proc traceError {args} {
sl@0	56	error "trace returned error"
sl@0	57	}
sl@0	58	proc traceCheck {cmd args} {
sl@0	59	global info
sl@0	60	set info [list [catch $cmd msg] $msg]
sl@0	61	}
sl@0	62	proc traceCrtElement {value name1 name2 op} {
sl@0	63	uplevel set ${name1}($name2) $value
sl@0	64	}
sl@0	65	proc traceCommand {oldName newName op} {
sl@0	66	global info
sl@0	67	set info [list $oldName $newName $op]
sl@0	68	}
sl@0	69
sl@0	70	test trace-0.0 {memory corruption in trace (Tcl Bug 484339)} {
sl@0	71	# You may need Purify or Electric Fence to reliably
sl@0	72	# see this one fail.
sl@0	73	catch {unset z}
sl@0	74	trace add variable z array {set z(foo) 1 ;#}
sl@0	75	set res "names: [array names z]"
sl@0	76	catch {unset ::z}
sl@0	77	trace variable ::z w {unset ::z; error "memory corruption";#}
sl@0	78	list [catch {set ::z 1} msg] $msg
sl@0	79	} {1 {can't set "::z": memory corruption}}
sl@0	80
sl@0	81	# Read-tracing on variables
sl@0	82
sl@0	83	test trace-1.1 {trace variable reads} {
sl@0	84	catch {unset x}
sl@0	85	set info {}
sl@0	86	trace add variable x read traceScalar
sl@0	87	list [catch {set x} msg] $msg $info
sl@0	88	} {1 {can't read "x": no such variable} {x {} read 1 {can't read "x": no such variable}}}
sl@0	89	test trace-1.2 {trace variable reads} {
sl@0	90	catch {unset x}
sl@0	91	set x 123
sl@0	92	set info {}
sl@0	93	trace add variable x read traceScalar
sl@0	94	list [catch {set x} msg] $msg $info
sl@0	95	} {0 123 {x {} read 0 123}}
sl@0	96	test trace-1.3 {trace variable reads} {
sl@0	97	catch {unset x}
sl@0	98	set info {}
sl@0	99	trace add variable x read traceScalar
sl@0	100	set x 123
sl@0	101	set info
sl@0	102	} {}
sl@0	103	test trace-1.4 {trace array element reads} {
sl@0	104	catch {unset x}
sl@0	105	set info {}
sl@0	106	trace add variable x(2) read traceArray
sl@0	107	list [catch {set x(2)} msg] $msg $info
sl@0	108	} {1 {can't read "x(2)": no such element in array} {x 2 read 1 {can't read "x(2)": no such element in array}}}
sl@0	109	test trace-1.5 {trace array element reads} {
sl@0	110	catch {unset x}
sl@0	111	set x(2) zzz
sl@0	112	set info {}
sl@0	113	trace add variable x(2) read traceArray
sl@0	114	list [catch {set x(2)} msg] $msg $info
sl@0	115	} {0 zzz {x 2 read 0 zzz}}
sl@0	116	test trace-1.6 {trace array element reads} {
sl@0	117	catch {unset x}
sl@0	118	set info {}
sl@0	119	trace add variable x read traceArray2
sl@0	120	proc p {} {
sl@0	121	global x
sl@0	122	set x(2) willi
sl@0	123	return $x(2)
sl@0	124	}
sl@0	125	list [catch {p} msg] $msg $info
sl@0	126	} {0 willi {x 2 read}}
sl@0	127	test trace-1.7 {trace array element reads, create element undefined if nonexistant} {
sl@0	128	catch {unset x}
sl@0	129	set info {}
sl@0	130	trace add variable x read q
sl@0	131	proc q {name1 name2 op} {
sl@0	132	global info
sl@0	133	set info [list $name1 $name2 $op]
sl@0	134	global $name1
sl@0	135	set ${name1}($name2) wolf
sl@0	136	}
sl@0	137	proc p {} {
sl@0	138	global x
sl@0	139	set x(X) willi
sl@0	140	return $x(Y)
sl@0	141	}
sl@0	142	list [catch {p} msg] $msg $info
sl@0	143	} {0 wolf {x Y read}}
sl@0	144	test trace-1.8 {trace reads on whole arrays} {
sl@0	145	catch {unset x}
sl@0	146	set info {}
sl@0	147	trace add variable x read traceArray
sl@0	148	list [catch {set x(2)} msg] $msg $info
sl@0	149	} {1 {can't read "x(2)": no such variable} {}}
sl@0	150	test trace-1.9 {trace reads on whole arrays} {
sl@0	151	catch {unset x}
sl@0	152	set x(2) zzz
sl@0	153	set info {}
sl@0	154	trace add variable x read traceArray
sl@0	155	list [catch {set x(2)} msg] $msg $info
sl@0	156	} {0 zzz {x 2 read 0 zzz}}
sl@0	157	test trace-1.10 {trace variable reads} {
sl@0	158	catch {unset x}
sl@0	159	set x 444
sl@0	160	set info {}
sl@0	161	trace add variable x read traceScalar
sl@0	162	unset x
sl@0	163	set info
sl@0	164	} {}
sl@0	165	test trace-1.11 {read traces that modify the array structure} {
sl@0	166	catch {unset x}
sl@0	167	set x(bar) 0
sl@0	168	trace variable x r {set x(foo) 1 ;#}
sl@0	169	trace variable x r {unset -nocomplain x(bar) ;#}
sl@0	170	array get x
sl@0	171	} {}
sl@0	172	test trace-1.12 {read traces that modify the array structure} {
sl@0	173	catch {unset x}
sl@0	174	set x(bar) 0
sl@0	175	trace variable x r {unset -nocomplain x(bar) ;#}
sl@0	176	trace variable x r {set x(foo) 1 ;#}
sl@0	177	array get x
sl@0	178	} {}
sl@0	179	test trace-1.13 {read traces that modify the array structure} {
sl@0	180	catch {unset x}
sl@0	181	set x(bar) 0
sl@0	182	trace variable x r {set x(foo) 1 ;#}
sl@0	183	trace variable x r {unset -nocomplain x;#}
sl@0	184	list [catch {array get x} res] $res
sl@0	185	} {1 {can't read "x(bar)": no such variable}}
sl@0	186	test trace-1.14 {read traces that modify the array structure} {
sl@0	187	catch {unset x}
sl@0	188	set x(bar) 0
sl@0	189	trace variable x r {unset -nocomplain x;#}
sl@0	190	trace variable x r {set x(foo) 1 ;#}
sl@0	191	list [catch {array get x} res] $res
sl@0	192	} {1 {can't read "x(bar)": no such variable}}
sl@0	193
sl@0	194	# Basic write-tracing on variables
sl@0	195
sl@0	196	test trace-2.1 {trace variable writes} {
sl@0	197	catch {unset x}
sl@0	198	set info {}
sl@0	199	trace add variable x write traceScalar
sl@0	200	set x 123
sl@0	201	set info
sl@0	202	} {x {} write 0 123}
sl@0	203	test trace-2.2 {trace writes to array elements} {
sl@0	204	catch {unset x}
sl@0	205	set info {}
sl@0	206	trace add variable x(33) write traceArray
sl@0	207	set x(33) 444
sl@0	208	set info
sl@0	209	} {x 33 write 0 444}
sl@0	210	test trace-2.3 {trace writes on whole arrays} {
sl@0	211	catch {unset x}
sl@0	212	set info {}
sl@0	213	trace add variable x write traceArray
sl@0	214	set x(abc) qq
sl@0	215	set info
sl@0	216	} {x abc write 0 qq}
sl@0	217	test trace-2.4 {trace variable writes} {
sl@0	218	catch {unset x}
sl@0	219	set x 1234
sl@0	220	set info {}
sl@0	221	trace add variable x write traceScalar
sl@0	222	set x
sl@0	223	set info
sl@0	224	} {}
sl@0	225	test trace-2.5 {trace variable writes} {
sl@0	226	catch {unset x}
sl@0	227	set x 1234
sl@0	228	set info {}
sl@0	229	trace add variable x write traceScalar
sl@0	230	unset x
sl@0	231	set info
sl@0	232	} {}
sl@0	233
sl@0	234	# append no longer triggers read traces when fetching the old values of
sl@0	235	# variables before doing the append operation. However, lappend _does_
sl@0	236	# still trigger these read traces. Also lappend triggers only one write
sl@0	237	# trace: after appending all arguments to the list.
sl@0	238
sl@0	239	test trace-3.1 {trace variable read-modify-writes} {
sl@0	240	catch {unset x}
sl@0	241	set info {}
sl@0	242	trace add variable x read traceScalarAppend
sl@0	243	append x 123
sl@0	244	append x 456
sl@0	245	lappend x 789
sl@0	246	set info
sl@0	247	} {x {} read 0 123456}
sl@0	248	test trace-3.2 {trace variable read-modify-writes} {
sl@0	249	catch {unset x}
sl@0	250	set info {}
sl@0	251	trace add variable x {read write} traceScalarAppend
sl@0	252	append x 123
sl@0	253	lappend x 456
sl@0	254	set info
sl@0	255	} {x {} write 0 123 x {} read 0 123 x {} write 0 {123 456}}
sl@0	256
sl@0	257	# Basic unset-tracing on variables
sl@0	258
sl@0	259	test trace-4.1 {trace variable unsets} {
sl@0	260	catch {unset x}
sl@0	261	set info {}
sl@0	262	trace add variable x unset traceScalar
sl@0	263	catch {unset x}
sl@0	264	set info
sl@0	265	} {x {} unset 1 {can't read "x": no such variable}}
sl@0	266	test trace-4.2 {variable mustn't exist during unset trace} {
sl@0	267	catch {unset x}
sl@0	268	set x 1234
sl@0	269	set info {}
sl@0	270	trace add variable x unset traceScalar
sl@0	271	unset x
sl@0	272	set info
sl@0	273	} {x {} unset 1 {can't read "x": no such variable}}
sl@0	274	test trace-4.3 {unset traces mustn't be called during reads and writes} {
sl@0	275	catch {unset x}
sl@0	276	set info {}
sl@0	277	trace add variable x unset traceScalar
sl@0	278	set x 44
sl@0	279	set x
sl@0	280	set info
sl@0	281	} {}
sl@0	282	test trace-4.4 {trace unsets on array elements} {
sl@0	283	catch {unset x}
sl@0	284	set x(0) 18
sl@0	285	set info {}
sl@0	286	trace add variable x(1) unset traceArray
sl@0	287	catch {unset x(1)}
sl@0	288	set info
sl@0	289	} {x 1 unset 1 {can't read "x(1)": no such element in array}}
sl@0	290	test trace-4.5 {trace unsets on array elements} {
sl@0	291	catch {unset x}
sl@0	292	set x(1) 18
sl@0	293	set info {}
sl@0	294	trace add variable x(1) unset traceArray
sl@0	295	unset x(1)
sl@0	296	set info
sl@0	297	} {x 1 unset 1 {can't read "x(1)": no such element in array}}
sl@0	298	test trace-4.6 {trace unsets on array elements} {
sl@0	299	catch {unset x}
sl@0	300	set x(1) 18
sl@0	301	set info {}
sl@0	302	trace add variable x(1) unset traceArray
sl@0	303	unset x
sl@0	304	set info
sl@0	305	} {x 1 unset 1 {can't read "x(1)": no such variable}}
sl@0	306	test trace-4.7 {trace unsets on whole arrays} {
sl@0	307	catch {unset x}
sl@0	308	set x(1) 18
sl@0	309	set info {}
sl@0	310	trace add variable x unset traceProc
sl@0	311	catch {unset x(0)}
sl@0	312	set info
sl@0	313	} {}
sl@0	314	test trace-4.8 {trace unsets on whole arrays} {
sl@0	315	catch {unset x}
sl@0	316	set x(1) 18
sl@0	317	set x(2) 144
sl@0	318	set x(3) 14
sl@0	319	set info {}
sl@0	320	trace add variable x unset traceProc
sl@0	321	unset x(1)
sl@0	322	set info
sl@0	323	} {x 1 unset}
sl@0	324	test trace-4.9 {trace unsets on whole arrays} {
sl@0	325	catch {unset x}
sl@0	326	set x(1) 18
sl@0	327	set x(2) 144
sl@0	328	set x(3) 14
sl@0	329	set info {}
sl@0	330	trace add variable x unset traceProc
sl@0	331	unset x
sl@0	332	set info
sl@0	333	} {x {} unset}
sl@0	334
sl@0	335	# Array tracing on variables
sl@0	336	test trace-5.1 {array traces fire on accesses via [array]} {
sl@0	337	catch {unset x}
sl@0	338	set x(b) 2
sl@0	339	trace add variable x array traceArray2
sl@0	340	set ::info {}
sl@0	341	array set x {a 1}
sl@0	342	set ::info
sl@0	343	} {x {} array}
sl@0	344	test trace-5.2 {array traces do not fire on normal accesses} {
sl@0	345	catch {unset x}
sl@0	346	set x(b) 2
sl@0	347	trace add variable x array traceArray2
sl@0	348	set ::info {}
sl@0	349	set x(a) 1
sl@0	350	set x(b) $x(a)
sl@0	351	set ::info
sl@0	352	} {}
sl@0	353	test trace-5.3 {array traces do not outlive variable} {
sl@0	354	catch {unset x}
sl@0	355	trace add variable x array traceArray2
sl@0	356	set ::info {}
sl@0	357	set x(a) 1
sl@0	358	unset x
sl@0	359	array set x {a 1}
sl@0	360	set ::info
sl@0	361	} {}
sl@0	362	test trace-5.4 {array traces properly listed in trace information} {
sl@0	363	catch {unset x}
sl@0	364	trace add variable x array traceArray2
sl@0	365	set result [trace info variable x]
sl@0	366	set result
sl@0	367	} [list [list array traceArray2]]
sl@0	368	test trace-5.5 {array traces properly listed in trace information} {
sl@0	369	catch {unset x}
sl@0	370	trace variable x a traceArray2
sl@0	371	set result [trace vinfo x]
sl@0	372	set result
sl@0	373	} [list [list a traceArray2]]
sl@0	374	test trace-5.6 {array traces don't fire on scalar variables} {
sl@0	375	catch {unset x}
sl@0	376	set x foo
sl@0	377	trace add variable x array traceArray2
sl@0	378	set ::info {}
sl@0	379	catch {array set x {a 1}}
sl@0	380	set ::info
sl@0	381	} {}
sl@0	382	test trace-5.7 {array traces fire for undefined variables} {
sl@0	383	catch {unset x}
sl@0	384	trace add variable x array traceArray2
sl@0	385	set ::info {}
sl@0	386	array set x {a 1}
sl@0	387	set ::info
sl@0	388	} {x {} array}
sl@0	389	test trace-5.8 {array traces fire for undefined variables} {
sl@0	390	catch {unset x}
sl@0	391	trace add variable x array {set x(foo) 1 ;#}
sl@0	392	set res "names: [array names x]"
sl@0	393	} {names: foo}
sl@0	394
sl@0	395	# Trace multiple trace types at once.
sl@0	396
sl@0	397	test trace-6.1 {multiple ops traced at once} {
sl@0	398	catch {unset x}
sl@0	399	set info {}
sl@0	400	trace add variable x {read write unset} traceProc
sl@0	401	catch {set x}
sl@0	402	set x 22
sl@0	403	set x
sl@0	404	set x 33
sl@0	405	unset x
sl@0	406	set info
sl@0	407	} {x {} read x {} write x {} read x {} write x {} unset}
sl@0	408	test trace-6.2 {multiple ops traced on array element} {
sl@0	409	catch {unset x}
sl@0	410	set info {}
sl@0	411	trace add variable x(0) {read write unset} traceProc
sl@0	412	catch {set x(0)}
sl@0	413	set x(0) 22
sl@0	414	set x(0)
sl@0	415	set x(0) 33
sl@0	416	unset x(0)
sl@0	417	unset x
sl@0	418	set info
sl@0	419	} {x 0 read x 0 write x 0 read x 0 write x 0 unset}
sl@0	420	test trace-6.3 {multiple ops traced on whole array} {
sl@0	421	catch {unset x}
sl@0	422	set info {}
sl@0	423	trace add variable x {read write unset} traceProc
sl@0	424	catch {set x(0)}
sl@0	425	set x(0) 22
sl@0	426	set x(0)
sl@0	427	set x(0) 33
sl@0	428	unset x(0)
sl@0	429	unset x
sl@0	430	set info
sl@0	431	} {x 0 write x 0 read x 0 write x 0 unset x {} unset}
sl@0	432
sl@0	433	# Check order of invocation of traces
sl@0	434
sl@0	435	test trace-7.1 {order of invocation of traces} {
sl@0	436	catch {unset x}
sl@0	437	set info {}
sl@0	438	trace add variable x read "traceTag 1"
sl@0	439	trace add variable x read "traceTag 2"
sl@0	440	trace add variable x read "traceTag 3"
sl@0	441	catch {set x}
sl@0	442	set x 22
sl@0	443	set x
sl@0	444	set info
sl@0	445	} {3 2 1 3 2 1}
sl@0	446	test trace-7.2 {order of invocation of traces} {
sl@0	447	catch {unset x}
sl@0	448	set x(0) 44
sl@0	449	set info {}
sl@0	450	trace add variable x(0) read "traceTag 1"
sl@0	451	trace add variable x(0) read "traceTag 2"
sl@0	452	trace add variable x(0) read "traceTag 3"
sl@0	453	set x(0)
sl@0	454	set info
sl@0	455	} {3 2 1}
sl@0	456	test trace-7.3 {order of invocation of traces} {
sl@0	457	catch {unset x}
sl@0	458	set x(0) 44
sl@0	459	set info {}
sl@0	460	trace add variable x(0) read "traceTag 1"
sl@0	461	trace add variable x read "traceTag A1"
sl@0	462	trace add variable x(0) read "traceTag 2"
sl@0	463	trace add variable x read "traceTag A2"
sl@0	464	trace add variable x(0) read "traceTag 3"
sl@0	465	trace add variable x read "traceTag A3"
sl@0	466	set x(0)
sl@0	467	set info
sl@0	468	} {A3 A2 A1 3 2 1}
sl@0	469
sl@0	470	# Check effects of errors in trace procedures
sl@0	471
sl@0	472	test trace-8.1 {error returns from traces} {
sl@0	473	catch {unset x}
sl@0	474	set x 123
sl@0	475	set info {}
sl@0	476	trace add variable x read "traceTag 1"
sl@0	477	trace add variable x read traceError
sl@0	478	list [catch {set x} msg] $msg $info
sl@0	479	} {1 {can't read "x": trace returned error} {}}
sl@0	480	test trace-8.2 {error returns from traces} {
sl@0	481	catch {unset x}
sl@0	482	set x 123
sl@0	483	set info {}
sl@0	484	trace add variable x write "traceTag 1"
sl@0	485	trace add variable x write traceError
sl@0	486	list [catch {set x 44} msg] $msg $info
sl@0	487	} {1 {can't set "x": trace returned error} {}}
sl@0	488	test trace-8.3 {error returns from traces} {
sl@0	489	catch {unset x}
sl@0	490	set x 123
sl@0	491	set info {}
sl@0	492	trace add variable x write traceError
sl@0	493	list [catch {append x 44} msg] $msg $info
sl@0	494	} {1 {can't set "x": trace returned error} {}}
sl@0	495	test trace-8.4 {error returns from traces} {
sl@0	496	catch {unset x}
sl@0	497	set x 123
sl@0	498	set info {}
sl@0	499	trace add variable x unset "traceTag 1"
sl@0	500	trace add variable x unset traceError
sl@0	501	list [catch {unset x} msg] $msg $info
sl@0	502	} {0 {} 1}
sl@0	503	test trace-8.5 {error returns from traces} {
sl@0	504	catch {unset x}
sl@0	505	set x(0) 123
sl@0	506	set info {}
sl@0	507	trace add variable x(0) read "traceTag 1"
sl@0	508	trace add variable x read "traceTag 2"
sl@0	509	trace add variable x read traceError
sl@0	510	trace add variable x read "traceTag 3"
sl@0	511	list [catch {set x(0)} msg] $msg $info
sl@0	512	} {1 {can't read "x(0)": trace returned error} 3}
sl@0	513	test trace-8.6 {error returns from traces} {
sl@0	514	catch {unset x}
sl@0	515	set x 123
sl@0	516	trace add variable x unset traceError
sl@0	517	list [catch {unset x} msg] $msg
sl@0	518	} {0 {}}
sl@0	519	test trace-8.7 {error returns from traces} {
sl@0	520	# This test just makes sure that the memory for the error message
sl@0	521	# gets deallocated correctly when the trace is invoked again or
sl@0	522	# when the trace is deleted.
sl@0	523	catch {unset x}
sl@0	524	set x 123
sl@0	525	trace add variable x read traceError
sl@0	526	catch {set x}
sl@0	527	catch {set x}
sl@0	528	trace remove variable x read traceError
sl@0	529	} {}
sl@0	530	test trace-8.8 {error returns from traces} {
sl@0	531	# Yet more elaborate memory corruption testing that checks nothing
sl@0	532	# bad happens when the trace deletes itself and installs something
sl@0	533	# new. Alas, there is no neat way to guarantee that this test will
sl@0	534	# fail if there is a problem, but that's life and with the new code
sl@0	535	# it should never fail.
sl@0	536	#
sl@0	537	# Adapted from Bug #219393 reported by Don Porter.
sl@0	538	catch {rename ::foo {}}
sl@0	539	proc foo {old args} {
sl@0	540	trace remove variable ::x write [list foo $old]
sl@0	541	trace add variable ::x write [list foo $::x]
sl@0	542	error "foo"
sl@0	543	}
sl@0	544	catch {unset ::x ::y}
sl@0	545	set x junk
sl@0	546	trace add variable ::x write [list foo $x]
sl@0	547	for {set y 0} {$y<100} {incr y} {
sl@0	548	catch {set x junk}
sl@0	549	}
sl@0	550	unset x
sl@0	551	} {}
sl@0	552
sl@0	553	# Check to see that variables are expunged before trace
sl@0	554	# procedures are invoked, so trace procedure can even manipulate
sl@0	555	# a new copy of the variables.
sl@0	556
sl@0	557	test trace-9.1 {be sure variable is unset before trace is called} {
sl@0	558	catch {unset x}
sl@0	559	set x 33
sl@0	560	set info {}
sl@0	561	trace add variable x unset {traceCheck {uplevel set x}}
sl@0	562	unset x
sl@0	563	set info
sl@0	564	} {1 {can't read "x": no such variable}}
sl@0	565	test trace-9.2 {be sure variable is unset before trace is called} {
sl@0	566	catch {unset x}
sl@0	567	set x 33
sl@0	568	set info {}
sl@0	569	trace add variable x unset {traceCheck {uplevel set x 22}}
sl@0	570	unset x
sl@0	571	concat $info [list [catch {set x} msg] $msg]
sl@0	572	} {0 22 0 22}
sl@0	573	test trace-9.3 {be sure traces are cleared before unset trace called} {
sl@0	574	catch {unset x}
sl@0	575	set x 33
sl@0	576	set info {}
sl@0	577	trace add variable x unset {traceCheck {uplevel trace info variable x}}
sl@0	578	unset x
sl@0	579	set info
sl@0	580	} {0 {}}
sl@0	581	test trace-9.4 {set new trace during unset trace} {
sl@0	582	catch {unset x}
sl@0	583	set x 33
sl@0	584	set info {}
sl@0	585	trace add variable x unset {traceCheck {global x; trace add variable x unset traceProc}}
sl@0	586	unset x
sl@0	587	concat $info [trace info variable x]
sl@0	588	} {0 {} {unset traceProc}}
sl@0	589
sl@0	590	test trace-10.1 {make sure array elements are unset before traces are called} {
sl@0	591	catch {unset x}
sl@0	592	set x(0) 33
sl@0	593	set info {}
sl@0	594	trace add variable x(0) unset {traceCheck {uplevel set x(0)}}
sl@0	595	unset x(0)
sl@0	596	set info
sl@0	597	} {1 {can't read "x(0)": no such element in array}}
sl@0	598	test trace-10.2 {make sure array elements are unset before traces are called} {
sl@0	599	catch {unset x}
sl@0	600	set x(0) 33
sl@0	601	set info {}
sl@0	602	trace add variable x(0) unset {traceCheck {uplevel set x(0) zzz}}
sl@0	603	unset x(0)
sl@0	604	concat $info [list [catch {set x(0)} msg] $msg]
sl@0	605	} {0 zzz 0 zzz}
sl@0	606	test trace-10.3 {array elements are unset before traces are called} {
sl@0	607	catch {unset x}
sl@0	608	set x(0) 33
sl@0	609	set info {}
sl@0	610	trace add variable x(0) unset {traceCheck {global x; trace info variable x(0)}}
sl@0	611	unset x(0)
sl@0	612	set info
sl@0	613	} {0 {}}
sl@0	614	test trace-10.4 {set new array element trace during unset trace} {
sl@0	615	catch {unset x}
sl@0	616	set x(0) 33
sl@0	617	set info {}
sl@0	618	trace add variable x(0) unset {traceCheck {uplevel {trace add variable x(0) read {}}}}
sl@0	619	catch {unset x(0)}
sl@0	620	concat $info [trace info variable x(0)]
sl@0	621	} {0 {} {read {}}}
sl@0	622
sl@0	623	test trace-11.1 {make sure arrays are unset before traces are called} {
sl@0	624	catch {unset x}
sl@0	625	set x(0) 33
sl@0	626	set info {}
sl@0	627	trace add variable x unset {traceCheck {uplevel set x(0)}}
sl@0	628	unset x
sl@0	629	set info
sl@0	630	} {1 {can't read "x(0)": no such variable}}
sl@0	631	test trace-11.2 {make sure arrays are unset before traces are called} {
sl@0	632	catch {unset x}
sl@0	633	set x(y) 33
sl@0	634	set info {}
sl@0	635	trace add variable x unset {traceCheck {uplevel set x(y) 22}}
sl@0	636	unset x
sl@0	637	concat $info [list [catch {set x(y)} msg] $msg]
sl@0	638	} {0 22 0 22}
sl@0	639	test trace-11.3 {make sure arrays are unset before traces are called} {
sl@0	640	catch {unset x}
sl@0	641	set x(y) 33
sl@0	642	set info {}
sl@0	643	trace add variable x unset {traceCheck {uplevel array exists x}}
sl@0	644	unset x
sl@0	645	set info
sl@0	646	} {0 0}
sl@0	647	test trace-11.4 {make sure arrays are unset before traces are called} {
sl@0	648	catch {unset x}
sl@0	649	set x(y) 33
sl@0	650	set info {}
sl@0	651	set cmd {traceCheck {uplevel {trace info variable x}}}
sl@0	652	trace add variable x unset $cmd
sl@0	653	unset x
sl@0	654	set info
sl@0	655	} {0 {}}
sl@0	656	test trace-11.5 {set new array trace during unset trace} {
sl@0	657	catch {unset x}
sl@0	658	set x(y) 33
sl@0	659	set info {}
sl@0	660	trace add variable x unset {traceCheck {global x; trace add variable x read {}}}
sl@0	661	unset x
sl@0	662	concat $info [trace info variable x]
sl@0	663	} {0 {} {read {}}}
sl@0	664	test trace-11.6 {create scalar during array unset trace} {
sl@0	665	catch {unset x}
sl@0	666	set x(y) 33
sl@0	667	set info {}
sl@0	668	trace add variable x unset {traceCheck {global x; set x 44}}
sl@0	669	unset x
sl@0	670	concat $info [list [catch {set x} msg] $msg]
sl@0	671	} {0 44 0 44}
sl@0	672
sl@0	673	# Check special conditions (e.g. errors) in Tcl_TraceVar2.
sl@0	674
sl@0	675	test trace-12.1 {creating array when setting variable traces} {
sl@0	676	catch {unset x}
sl@0	677	set info {}
sl@0	678	trace add variable x(0) write traceProc
sl@0	679	list [catch {set x 22} msg] $msg
sl@0	680	} {1 {can't set "x": variable is array}}
sl@0	681	test trace-12.2 {creating array when setting variable traces} {
sl@0	682	catch {unset x}
sl@0	683	set info {}
sl@0	684	trace add variable x(0) write traceProc
sl@0	685	list [catch {set x(0)} msg] $msg
sl@0	686	} {1 {can't read "x(0)": no such element in array}}
sl@0	687	test trace-12.3 {creating array when setting variable traces} {
sl@0	688	catch {unset x}
sl@0	689	set info {}
sl@0	690	trace add variable x(0) write traceProc
sl@0	691	set x(0) 22
sl@0	692	set info
sl@0	693	} {x 0 write}
sl@0	694	test trace-12.4 {creating variable when setting variable traces} {
sl@0	695	catch {unset x}
sl@0	696	set info {}
sl@0	697	trace add variable x write traceProc
sl@0	698	list [catch {set x} msg] $msg
sl@0	699	} {1 {can't read "x": no such variable}}
sl@0	700	test trace-12.5 {creating variable when setting variable traces} {
sl@0	701	catch {unset x}
sl@0	702	set info {}
sl@0	703	trace add variable x write traceProc
sl@0	704	set x 22
sl@0	705	set info
sl@0	706	} {x {} write}
sl@0	707	test trace-12.6 {creating variable when setting variable traces} {
sl@0	708	catch {unset x}
sl@0	709	set info {}
sl@0	710	trace add variable x write traceProc
sl@0	711	set x(0) 22
sl@0	712	set info
sl@0	713	} {x 0 write}
sl@0	714	test trace-12.7 {create array element during read trace} {
sl@0	715	catch {unset x}
sl@0	716	set x(2) zzz
sl@0	717	trace add variable x read {traceCrtElement xyzzy}
sl@0	718	list [catch {set x(3)} msg] $msg
sl@0	719	} {0 xyzzy}
sl@0	720	test trace-12.8 {errors when setting variable traces} {
sl@0	721	catch {unset x}
sl@0	722	set x 44
sl@0	723	list [catch {trace add variable x(0) write traceProc} msg] $msg
sl@0	724	} {1 {can't trace "x(0)": variable isn't array}}
sl@0	725
sl@0	726	# Check trace deletion
sl@0	727
sl@0	728	test trace-13.1 {delete one trace from another} {
sl@0	729	proc delTraces {args} {
sl@0	730	global x
sl@0	731	trace remove variable x read {traceTag 2}
sl@0	732	trace remove variable x read {traceTag 3}
sl@0	733	trace remove variable x read {traceTag 4}
sl@0	734	}
sl@0	735	catch {unset x}
sl@0	736	set x 44
sl@0	737	set info {}
sl@0	738	trace add variable x read {traceTag 1}
sl@0	739	trace add variable x read {traceTag 2}
sl@0	740	trace add variable x read {traceTag 3}
sl@0	741	trace add variable x read {traceTag 4}
sl@0	742	trace add variable x read delTraces
sl@0	743	trace add variable x read {traceTag 5}
sl@0	744	set x
sl@0	745	set info
sl@0	746	} {5 1}
sl@0	747	test trace-13.2 {leak when unsetting traced variable} \
sl@0	748	-constraints memory -body {
sl@0	749	set end [getbytes]
sl@0	750	proc f args {}
sl@0	751	for {set i 0} {$i < 5} {incr i} {
sl@0	752	trace add variable bepa write f
sl@0	753	set bepa a
sl@0	754	unset bepa
sl@0	755	set tmp $end
sl@0	756	set end [getbytes]
sl@0	757	}
sl@0	758	expr {$end - $tmp}
sl@0	759	} -cleanup {
sl@0	760	unset -nocomplain end i tmp
sl@0	761	} -result 0
sl@0	762	test trace-13.3 {leak when removing traces} \
sl@0	763	-constraints memory -body {
sl@0	764	set end [getbytes]
sl@0	765	proc f args {}
sl@0	766	for {set i 0} {$i < 5} {incr i} {
sl@0	767	trace add variable bepa write f
sl@0	768	set bepa a
sl@0	769	trace remove variable bepa write f
sl@0	770	set tmp $end
sl@0	771	set end [getbytes]
sl@0	772	}
sl@0	773	expr {$end - $tmp}
sl@0	774	} -cleanup {
sl@0	775	unset -nocomplain end i tmp
sl@0	776	} -result 0
sl@0	777	test trace-13.4 {leaks in error returns from traces} \
sl@0	778	-constraints memory -body {
sl@0	779	set end [getbytes]
sl@0	780	for {set i 0} {$i < 5} {incr i} {
sl@0	781	set apa {a 1 b 2}
sl@0	782	set bepa [lrange $apa 0 end]
sl@0	783	trace add variable bepa write {error hej}
sl@0	784	catch {set bepa a}
sl@0	785	unset bepa
sl@0	786	set tmp $end
sl@0	787	set end [getbytes]
sl@0	788	}
sl@0	789	expr {$end - $tmp}
sl@0	790	} -cleanup {
sl@0	791	unset -nocomplain end i tmp
sl@0	792	} -result 0
sl@0	793
sl@0	794	# Check operation and syntax of "trace" command.
sl@0	795
sl@0	796	# Syntax for adding/removing variable and command traces is basically the
sl@0	797	# same:
sl@0	798	# trace add variable name opList command
sl@0	799	# trace remove variable name opList command
sl@0	800	#
sl@0	801	# The following loops just get all the common "wrong # args" tests done.
sl@0	802
sl@0	803	set i 0
sl@0	804	set start "wrong # args:"
sl@0	805	foreach type {variable command} {
sl@0	806	foreach op {add remove} {
sl@0	807	test trace-14.0.[incr i] "trace command, wrong # args errors" {
sl@0	808	list [catch {trace $op $type} msg] $msg
sl@0	809	} [list 1 "$start should be \"trace $op $type name opList command\""]
sl@0	810	test trace-14.0.[incr i] "trace command wrong # args errors" {
sl@0	811	list [catch {trace $op $type foo} msg] $msg
sl@0	812	} [list 1 "$start should be \"trace $op $type name opList command\""]
sl@0	813	test trace-14.0.[incr i] "trace command, wrong # args errors" {
sl@0	814	list [catch {trace $op $type foo bar} msg] $msg
sl@0	815	} [list 1 "$start should be \"trace $op $type name opList command\""]
sl@0	816	test trace-14.0.[incr i] "trace command, wrong # args errors" {
sl@0	817	list [catch {trace $op $type foo bar baz boo} msg] $msg
sl@0	818	} [list 1 "$start should be \"trace $op $type name opList command\""]
sl@0	819	}
sl@0	820	test trace-14.0.[incr i] "trace command, wrong # args errors" {
sl@0	821	list [catch {trace info $type foo bar} msg] $msg
sl@0	822	} [list 1 "$start should be \"trace info $type name\""]
sl@0	823	test trace-14.0.[incr i] "trace command, wrong # args errors" {
sl@0	824	list [catch {trace info $type} msg] $msg
sl@0	825	} [list 1 "$start should be \"trace info $type name\""]
sl@0	826	}
sl@0	827
sl@0	828	test trace-14.1 "trace command, wrong # args errors" {
sl@0	829	list [catch {trace} msg] $msg
sl@0	830	} [list 1 "wrong # args: should be \"trace option ?arg arg ...?\""]
sl@0	831	test trace-14.2 "trace command, wrong # args errors" {
sl@0	832	list [catch {trace add} msg] $msg
sl@0	833	} [list 1 "wrong # args: should be \"trace add type ?arg arg ...?\""]
sl@0	834	test trace-14.3 "trace command, wrong # args errors" {
sl@0	835	list [catch {trace remove} msg] $msg
sl@0	836	} [list 1 "wrong # args: should be \"trace remove type ?arg arg ...?\""]
sl@0	837	test trace-14.4 "trace command, wrong # args errors" {
sl@0	838	list [catch {trace info} msg] $msg
sl@0	839	} [list 1 "wrong # args: should be \"trace info type ?arg arg ...?\""]
sl@0	840
sl@0	841	test trace-14.5 {trace command, invalid option} {
sl@0	842	list [catch {trace gorp} msg] $msg
sl@0	843	} [list 1 "bad option \"gorp\": must be add, info, remove, variable, vdelete, or vinfo"]
sl@0	844
sl@0	845	# Again, [trace ... command] and [trace ... variable] share syntax and
sl@0	846	# error message styles for their opList options; these loops test those
sl@0	847	# error messages.
sl@0	848
sl@0	849	set i 0
sl@0	850	set errs [list "array, read, unset, or write" "delete or rename" "enter, leave, enterstep, or leavestep"]
sl@0	851	set abbvs [list {a r u w} {d r} {}]
sl@0	852	proc x {} {}
sl@0	853	foreach type {variable command execution} err $errs abbvlist $abbvs {
sl@0	854	foreach op {add remove} {
sl@0	855	test trace-14.6.[incr i] "trace $op $type errors" {
sl@0	856	list [catch {trace $op $type x {y z w} a} msg] $msg
sl@0	857	} [list 1 "bad operation \"y\": must be $err"]
sl@0	858	foreach abbv $abbvlist {
sl@0	859	test trace-14.6.[incr i] "trace $op $type rejects abbreviations" {
sl@0	860	list [catch {trace $op $type x $abbv a} msg] $msg
sl@0	861	} [list 1 "bad operation \"$abbv\": must be $err"]
sl@0	862	}
sl@0	863	test trace-14.6.[incr i] "trace $op $type rejects null opList" {
sl@0	864	list [catch {trace $op $type x {} a} msg] $msg
sl@0	865	} [list 1 "bad operation list \"\": must be one or more of $err"]
sl@0	866	}
sl@0	867	}
sl@0	868	rename x {}
sl@0	869
sl@0	870	test trace-14.7 {trace command, "trace variable" errors} {
sl@0	871	list [catch {trace variable} msg] $msg
sl@0	872	} [list 1 "wrong # args: should be \"trace variable name ops command\""]
sl@0	873	test trace-14.8 {trace command, "trace variable" errors} {
sl@0	874	list [catch {trace variable x} msg] $msg
sl@0	875	} [list 1 "wrong # args: should be \"trace variable name ops command\""]
sl@0	876	test trace-14.9 {trace command, "trace variable" errors} {
sl@0	877	list [catch {trace variable x y} msg] $msg
sl@0	878	} [list 1 "wrong # args: should be \"trace variable name ops command\""]
sl@0	879	test trace-14.10 {trace command, "trace variable" errors} {
sl@0	880	list [catch {trace variable x y z w} msg] $msg
sl@0	881	} [list 1 "wrong # args: should be \"trace variable name ops command\""]
sl@0	882	test trace-14.11 {trace command, "trace variable" errors} {
sl@0	883	list [catch {trace variable x y z} msg] $msg
sl@0	884	} [list 1 "bad operations \"y\": should be one or more of rwua"]
sl@0	885
sl@0	886
sl@0	887	test trace-14.12 {trace command ("remove variable" option)} {
sl@0	888	catch {unset x}
sl@0	889	set info {}
sl@0	890	trace add variable x write traceProc
sl@0	891	trace remove variable x write traceProc
sl@0	892	} {}
sl@0	893	test trace-14.13 {trace command ("remove variable" option)} {
sl@0	894	catch {unset x}
sl@0	895	set info {}
sl@0	896	trace add variable x write traceProc
sl@0	897	trace remove variable x write traceProc
sl@0	898	set x 12345
sl@0	899	set info
sl@0	900	} {}
sl@0	901	test trace-14.14 {trace command ("remove variable" option)} {
sl@0	902	catch {unset x}
sl@0	903	set info {}
sl@0	904	trace add variable x write {traceTag 1}
sl@0	905	trace add variable x write traceProc
sl@0	906	trace add variable x write {traceTag 2}
sl@0	907	set x yy
sl@0	908	trace remove variable x write traceProc
sl@0	909	set x 12345
sl@0	910	trace remove variable x write {traceTag 1}
sl@0	911	set x foo
sl@0	912	trace remove variable x write {traceTag 2}
sl@0	913	set x gorp
sl@0	914	set info
sl@0	915	} {2 x {} write 1 2 1 2}
sl@0	916	test trace-14.15 {trace command ("remove variable" option)} {
sl@0	917	catch {unset x}
sl@0	918	set info {}
sl@0	919	trace add variable x write {traceTag 1}
sl@0	920	trace remove variable x write non_existent
sl@0	921	set x 12345
sl@0	922	set info
sl@0	923	} {1}
sl@0	924	test trace-14.16 {trace command ("info variable" option)} {
sl@0	925	catch {unset x}
sl@0	926	trace add variable x write {traceTag 1}
sl@0	927	trace add variable x write traceProc
sl@0	928	trace add variable x write {traceTag 2}
sl@0	929	trace info variable x
sl@0	930	} {{write {traceTag 2}} {write traceProc} {write {traceTag 1}}}
sl@0	931	test trace-14.17 {trace command ("info variable" option)} {
sl@0	932	catch {unset x}
sl@0	933	trace info variable x
sl@0	934	} {}
sl@0	935	test trace-14.18 {trace command ("info variable" option)} {
sl@0	936	catch {unset x}
sl@0	937	trace info variable x(0)
sl@0	938	} {}
sl@0	939	test trace-14.19 {trace command ("info variable" option)} {
sl@0	940	catch {unset x}
sl@0	941	set x 44
sl@0	942	trace info variable x(0)
sl@0	943	} {}
sl@0	944	test trace-14.20 {trace command ("info variable" option)} {
sl@0	945	catch {unset x}
sl@0	946	set x 44
sl@0	947	trace add variable x write {traceTag 1}
sl@0	948	proc check {} {global x; trace info variable x}
sl@0	949	check
sl@0	950	} {{write {traceTag 1}}}
sl@0	951
sl@0	952	# Check fancy trace commands (long ones, weird arguments, etc.)
sl@0	953
sl@0	954	test trace-15.1 {long trace command} {
sl@0	955	catch {unset x}
sl@0	956	set info {}
sl@0	957	trace add variable x write {traceTag {This is a very very long argument. It's \
sl@0	958	designed to test out the facilities of TraceVarProc for dealing \
sl@0	959	with such long arguments by malloc-ing space. One possibility \
sl@0	960	is that space doesn't get freed properly. If this happens, then \
sl@0	961	invoking this test over and over again will eventually leak memory.}}
sl@0	962	set x 44
sl@0	963	set info
sl@0	964	} {This is a very very long argument. It's \
sl@0	965	designed to test out the facilities of TraceVarProc for dealing \
sl@0	966	with such long arguments by malloc-ing space. One possibility \
sl@0	967	is that space doesn't get freed properly. If this happens, then \
sl@0	968	invoking this test over and over again will eventually leak memory.}
sl@0	969	test trace-15.2 {long trace command result to ignore} {
sl@0	970	proc longResult {args} {return "quite a bit of text, designed to
sl@0	971	generate a core leak if this command file is invoked over and over again
sl@0	972	and memory isn't being recycled correctly"}
sl@0	973	catch {unset x}
sl@0	974	trace add variable x write longResult
sl@0	975	set x 44
sl@0	976	set x 5
sl@0	977	set x abcde
sl@0	978	} abcde
sl@0	979	test trace-15.3 {special list-handling in trace commands} {
sl@0	980	catch {unset "x y z"}
sl@0	981	set "x y z(a\n\{)" 44
sl@0	982	set info {}
sl@0	983	trace add variable "x y z(a\n\{)" write traceProc
sl@0	984	set "x y z(a\n\{)" 33
sl@0	985	set info
sl@0	986	} "{x y z} a\\n\\\{ write"
sl@0	987
sl@0	988	# Check for proper handling of unsets during traces.
sl@0	989
sl@0	990	proc traceUnset {unsetName args} {
sl@0	991	global info
sl@0	992	upvar $unsetName x
sl@0	993	lappend info [catch {unset x} msg] $msg [catch {set x} msg] $msg
sl@0	994	}
sl@0	995	proc traceReset {unsetName resetName args} {
sl@0	996	global info
sl@0	997	upvar $unsetName x $resetName y
sl@0	998	lappend info [catch {unset x} msg] $msg [catch {set y xyzzy} msg] $msg
sl@0	999	}
sl@0	1000	proc traceReset2 {unsetName resetName args} {
sl@0	1001	global info
sl@0	1002	lappend info [catch {uplevel unset $unsetName} msg] $msg \
sl@0	1003	[catch {uplevel set $resetName xyzzy} msg] $msg
sl@0	1004	}
sl@0	1005	proc traceAppend {string name1 name2 op} {
sl@0	1006	global info
sl@0	1007	lappend info $string
sl@0	1008	}
sl@0	1009
sl@0	1010	test trace-16.1 {unsets during read traces} {
sl@0	1011	catch {unset y}
sl@0	1012	set y 1234
sl@0	1013	set info {}
sl@0	1014	trace add variable y read {traceUnset y}
sl@0	1015	trace add variable y unset {traceAppend unset}
sl@0	1016	lappend info [catch {set y} msg] $msg
sl@0	1017	} {unset 0 {} 1 {can't read "x": no such variable} 1 {can't read "y": no such variable}}
sl@0	1018	test trace-16.2 {unsets during read traces} {
sl@0	1019	catch {unset y}
sl@0	1020	set y(0) 1234
sl@0	1021	set info {}
sl@0	1022	trace add variable y(0) read {traceUnset y(0)}
sl@0	1023	lappend info [catch {set y(0)} msg] $msg
sl@0	1024	} {0 {} 1 {can't read "x": no such variable} 1 {can't read "y(0)": no such element in array}}
sl@0	1025	test trace-16.3 {unsets during read traces} {
sl@0	1026	catch {unset y}
sl@0	1027	set y(0) 1234
sl@0	1028	set info {}
sl@0	1029	trace add variable y(0) read {traceUnset y}
sl@0	1030	lappend info [catch {set y(0)} msg] $msg
sl@0	1031	} {0 {} 1 {can't read "x": no such variable} 1 {can't read "y(0)": no such variable}}
sl@0	1032	test trace-16.4 {unsets during read traces} {
sl@0	1033	catch {unset y}
sl@0	1034	set y 1234
sl@0	1035	set info {}
sl@0	1036	trace add variable y read {traceReset y y}
sl@0	1037	lappend info [catch {set y} msg] $msg
sl@0	1038	} {0 {} 0 xyzzy 0 xyzzy}
sl@0	1039	test trace-16.5 {unsets during read traces} {
sl@0	1040	catch {unset y}
sl@0	1041	set y(0) 1234
sl@0	1042	set info {}
sl@0	1043	trace add variable y(0) read {traceReset y(0) y(0)}
sl@0	1044	lappend info [catch {set y(0)} msg] $msg
sl@0	1045	} {0 {} 0 xyzzy 0 xyzzy}
sl@0	1046	test trace-16.6 {unsets during read traces} {
sl@0	1047	catch {unset y}
sl@0	1048	set y(0) 1234
sl@0	1049	set info {}
sl@0	1050	trace add variable y(0) read {traceReset y y(0)}
sl@0	1051	lappend info [catch {set y(0)} msg] $msg [catch {set y(0)} msg] $msg
sl@0	1052	} {0 {} 1 {can't set "y": upvar refers to element in deleted array} 1 {can't read "y(0)": no such variable} 1 {can't read "y(0)": no such variable}}
sl@0	1053	test trace-16.7 {unsets during read traces} {
sl@0	1054	catch {unset y}
sl@0	1055	set y(0) 1234
sl@0	1056	set info {}
sl@0	1057	trace add variable y(0) read {traceReset2 y y(0)}
sl@0	1058	lappend info [catch {set y(0)} msg] $msg [catch {set y(0)} msg] $msg
sl@0	1059	} {0 {} 0 xyzzy 1 {can't read "y(0)": no such element in array} 0 xyzzy}
sl@0	1060	test trace-16.8 {unsets during write traces} {
sl@0	1061	catch {unset y}
sl@0	1062	set y 1234
sl@0	1063	set info {}
sl@0	1064	trace add variable y write {traceUnset y}
sl@0	1065	trace add variable y unset {traceAppend unset}
sl@0	1066	lappend info [catch {set y xxx} msg] $msg
sl@0	1067	} {unset 0 {} 1 {can't read "x": no such variable} 0 {}}
sl@0	1068	test trace-16.9 {unsets during write traces} {
sl@0	1069	catch {unset y}
sl@0	1070	set y(0) 1234
sl@0	1071	set info {}
sl@0	1072	trace add variable y(0) write {traceUnset y(0)}
sl@0	1073	lappend info [catch {set y(0) xxx} msg] $msg
sl@0	1074	} {0 {} 1 {can't read "x": no such variable} 0 {}}
sl@0	1075	test trace-16.10 {unsets during write traces} {
sl@0	1076	catch {unset y}
sl@0	1077	set y(0) 1234
sl@0	1078	set info {}
sl@0	1079	trace add variable y(0) write {traceUnset y}
sl@0	1080	lappend info [catch {set y(0) xxx} msg] $msg
sl@0	1081	} {0 {} 1 {can't read "x": no such variable} 0 {}}
sl@0	1082	test trace-16.11 {unsets during write traces} {
sl@0	1083	catch {unset y}
sl@0	1084	set y 1234
sl@0	1085	set info {}
sl@0	1086	trace add variable y write {traceReset y y}
sl@0	1087	lappend info [catch {set y xxx} msg] $msg
sl@0	1088	} {0 {} 0 xyzzy 0 xyzzy}
sl@0	1089	test trace-16.12 {unsets during write traces} {
sl@0	1090	catch {unset y}
sl@0	1091	set y(0) 1234
sl@0	1092	set info {}
sl@0	1093	trace add variable y(0) write {traceReset y(0) y(0)}
sl@0	1094	lappend info [catch {set y(0) xxx} msg] $msg
sl@0	1095	} {0 {} 0 xyzzy 0 xyzzy}
sl@0	1096	test trace-16.13 {unsets during write traces} {
sl@0	1097	catch {unset y}
sl@0	1098	set y(0) 1234
sl@0	1099	set info {}
sl@0	1100	trace add variable y(0) write {traceReset y y(0)}
sl@0	1101	lappend info [catch {set y(0) xxx} msg] $msg [catch {set y(0)} msg] $msg
sl@0	1102	} {0 {} 1 {can't set "y": upvar refers to element in deleted array} 0 {} 1 {can't read "y(0)": no such variable}}
sl@0	1103	test trace-16.14 {unsets during write traces} {
sl@0	1104	catch {unset y}
sl@0	1105	set y(0) 1234
sl@0	1106	set info {}
sl@0	1107	trace add variable y(0) write {traceReset2 y y(0)}
sl@0	1108	lappend info [catch {set y(0) xxx} msg] $msg [catch {set y(0)} msg] $msg
sl@0	1109	} {0 {} 0 xyzzy 0 {} 0 xyzzy}
sl@0	1110	test trace-16.15 {unsets during unset traces} {
sl@0	1111	catch {unset y}
sl@0	1112	set y 1234
sl@0	1113	set info {}
sl@0	1114	trace add variable y unset {traceUnset y}
sl@0	1115	lappend info [catch {unset y} msg] $msg [catch {set y} msg] $msg
sl@0	1116	} {1 {can't unset "x": no such variable} 1 {can't read "x": no such variable} 0 {} 1 {can't read "y": no such variable}}
sl@0	1117	test trace-16.16 {unsets during unset traces} {
sl@0	1118	catch {unset y}
sl@0	1119	set y(0) 1234
sl@0	1120	set info {}
sl@0	1121	trace add variable y(0) unset {traceUnset y(0)}
sl@0	1122	lappend info [catch {unset y(0)} msg] $msg [catch {set y(0)} msg] $msg
sl@0	1123	} {1 {can't unset "x": no such variable} 1 {can't read "x": no such variable} 0 {} 1 {can't read "y(0)": no such element in array}}
sl@0	1124	test trace-16.17 {unsets during unset traces} {
sl@0	1125	catch {unset y}
sl@0	1126	set y(0) 1234
sl@0	1127	set info {}
sl@0	1128	trace add variable y(0) unset {traceUnset y}
sl@0	1129	lappend info [catch {unset y(0)} msg] $msg [catch {set y(0)} msg] $msg
sl@0	1130	} {0 {} 1 {can't read "x": no such variable} 0 {} 1 {can't read "y(0)": no such variable}}
sl@0	1131	test trace-16.18 {unsets during unset traces} {
sl@0	1132	catch {unset y}
sl@0	1133	set y 1234
sl@0	1134	set info {}
sl@0	1135	trace add variable y unset {traceReset2 y y}
sl@0	1136	lappend info [catch {unset y} msg] $msg [catch {set y} msg] $msg
sl@0	1137	} {1 {can't unset "y": no such variable} 0 xyzzy 0 {} 0 xyzzy}
sl@0	1138	test trace-16.19 {unsets during unset traces} {
sl@0	1139	catch {unset y}
sl@0	1140	set y(0) 1234
sl@0	1141	set info {}
sl@0	1142	trace add variable y(0) unset {traceReset2 y(0) y(0)}
sl@0	1143	lappend info [catch {unset y(0)} msg] $msg [catch {set y(0)} msg] $msg
sl@0	1144	} {1 {can't unset "y(0)": no such element in array} 0 xyzzy 0 {} 0 xyzzy}
sl@0	1145	test trace-16.20 {unsets during unset traces} {
sl@0	1146	catch {unset y}
sl@0	1147	set y(0) 1234
sl@0	1148	set info {}
sl@0	1149	trace add variable y(0) unset {traceReset2 y y(0)}
sl@0	1150	lappend info [catch {unset y(0)} msg] $msg [catch {set y(0)} msg] $msg
sl@0	1151	} {0 {} 0 xyzzy 0 {} 0 xyzzy}
sl@0	1152	test trace-16.21 {unsets cancelling traces} {
sl@0	1153	catch {unset y}
sl@0	1154	set y 1234
sl@0	1155	set info {}
sl@0	1156	trace add variable y read {traceAppend first}
sl@0	1157	trace add variable y read {traceUnset y}
sl@0	1158	trace add variable y read {traceAppend third}
sl@0	1159	trace add variable y unset {traceAppend unset}
sl@0	1160	lappend info [catch {set y} msg] $msg
sl@0	1161	} {third unset 0 {} 1 {can't read "x": no such variable} 1 {can't read "y": no such variable}}
sl@0	1162	test trace-16.22 {unsets cancelling traces} {
sl@0	1163	catch {unset y}
sl@0	1164	set y(0) 1234
sl@0	1165	set info {}
sl@0	1166	trace add variable y(0) read {traceAppend first}
sl@0	1167	trace add variable y(0) read {traceUnset y}
sl@0	1168	trace add variable y(0) read {traceAppend third}
sl@0	1169	trace add variable y(0) unset {traceAppend unset}
sl@0	1170	lappend info [catch {set y(0)} msg] $msg
sl@0	1171	} {third unset 0 {} 1 {can't read "x": no such variable} 1 {can't read "y(0)": no such variable}}
sl@0	1172
sl@0	1173	# Check various non-interference between traces and other things.
sl@0	1174
sl@0	1175	test trace-17.1 {trace doesn't prevent unset errors} {
sl@0	1176	catch {unset x}
sl@0	1177	set info {}
sl@0	1178	trace add variable x unset {traceProc}
sl@0	1179	list [catch {unset x} msg] $msg $info
sl@0	1180	} {1 {can't unset "x": no such variable} {x {} unset}}
sl@0	1181	test trace-17.2 {traced variables must survive procedure exits} {
sl@0	1182	catch {unset x}
sl@0	1183	proc p1 {} {global x; trace add variable x write traceProc}
sl@0	1184	p1
sl@0	1185	trace info variable x
sl@0	1186	} {{write traceProc}}
sl@0	1187	test trace-17.3 {traced variables must survive procedure exits} {
sl@0	1188	catch {unset x}
sl@0	1189	set info {}
sl@0	1190	proc p1 {} {global x; trace add variable x write traceProc}
sl@0	1191	p1
sl@0	1192	set x 44
sl@0	1193	set info
sl@0	1194	} {x {} write}
sl@0	1195
sl@0	1196	# Be sure that procedure frames are released before unset traces
sl@0	1197	# are invoked.
sl@0	1198
sl@0	1199	test trace-18.1 {unset traces on procedure returns} {
sl@0	1200	proc p1 {x y} {set a 44; p2 14}
sl@0	1201	proc p2 {z} {trace add variable z unset {traceCheck {lsort [uplevel {info vars}]}}}
sl@0	1202	set info {}
sl@0	1203	p1 foo bar
sl@0	1204	set info
sl@0	1205	} {0 {a x y}}
sl@0	1206	test trace-18.2 {namespace delete / trace vdelete combo} {
sl@0	1207	namespace eval ::foo {
sl@0	1208	variable x 123
sl@0	1209	}
sl@0	1210	proc p1 args {
sl@0	1211	trace vdelete ::foo::x u p1
sl@0	1212	}
sl@0	1213	trace variable ::foo::x u p1
sl@0	1214	namespace delete ::foo
sl@0	1215	info exists ::foo::x
sl@0	1216	} 0
sl@0	1217	test trace-18.3 {namespace delete / trace vdelete combo, Bug \#1337229} {
sl@0	1218	namespace eval ::ns {}
sl@0	1219	trace add variable ::ns::var unset {unset ::ns::var ;#}
sl@0	1220	namespace delete ::ns
sl@0	1221	} {}
sl@0	1222	test trace-18.4 {namespace delete / trace vdelete combo, Bug \#1338280} {
sl@0	1223	namespace eval ::ref {}
sl@0	1224	set ::ref::var1 AAA
sl@0	1225	trace add variable ::ref::var1 unset doTrace
sl@0	1226	set ::ref::var2 BBB
sl@0	1227	trace add variable ::ref::var2 {unset} doTrace
sl@0	1228	proc doTrace {vtraced vidx op} {
sl@0	1229	global info
sl@0	1230	append info [catch {set ::$vtraced}][llength [info vars ::ref::*]]
sl@0	1231	}
sl@0	1232	set info {}
sl@0	1233	namespace delete ::ref
sl@0	1234	rename doTrace {}
sl@0	1235	set info
sl@0	1236	} 1110
sl@0	1237
sl@0	1238	# Delete arrays when done, so they can be re-used as scalars
sl@0	1239	# elsewhere.
sl@0	1240
sl@0	1241	catch {unset x}
sl@0	1242	catch {unset y}
sl@0	1243
sl@0	1244	test trace-19.0.1 {trace add command (command existence)} {
sl@0	1245	# Just in case!
sl@0	1246	catch {rename nosuchname ""}
sl@0	1247	list [catch {trace add command nosuchname rename traceCommand} msg] $msg
sl@0	1248	} {1 {unknown command "nosuchname"}}
sl@0	1249	test trace-19.0.2 {trace add command (command existence in ns)} {
sl@0	1250	list [catch {trace add command nosuchns::nosuchname rename traceCommand} msg] $msg
sl@0	1251	} {1 {unknown command "nosuchns::nosuchname"}}
sl@0	1252
sl@0	1253
sl@0	1254	test trace-19.1 {trace add command (rename option)} {
sl@0	1255	proc foo {} {}
sl@0	1256	catch {rename bar {}}
sl@0	1257	trace add command foo rename traceCommand
sl@0	1258	rename foo bar
sl@0	1259	set info
sl@0	1260	} {::foo ::bar rename}
sl@0	1261	test trace-19.2 {traces stick with renamed commands} {
sl@0	1262	proc foo {} {}
sl@0	1263	catch {rename bar {}}
sl@0	1264	trace add command foo rename traceCommand
sl@0	1265	rename foo bar
sl@0	1266	rename bar foo
sl@0	1267	set info
sl@0	1268	} {::bar ::foo rename}
sl@0	1269	test trace-19.2.1 {trace add command rename trace exists} {
sl@0	1270	proc foo {} {}
sl@0	1271	trace add command foo rename traceCommand
sl@0	1272	trace info command foo
sl@0	1273	} {{rename traceCommand}}
sl@0	1274	test trace-19.3 {command rename traces don't fire on command deletion} {
sl@0	1275	proc foo {} {}
sl@0	1276	set info {}
sl@0	1277	trace add command foo rename traceCommand
sl@0	1278	rename foo {}
sl@0	1279	set info
sl@0	1280	} {}
sl@0	1281	test trace-19.4 {trace add command rename doesn't trace recreated commands} {
sl@0	1282	proc foo {} {}
sl@0	1283	catch {rename bar {}}
sl@0	1284	trace add command foo rename traceCommand
sl@0	1285	proc foo {} {}
sl@0	1286	rename foo bar
sl@0	1287	set info
sl@0	1288	} {}
sl@0	1289	test trace-19.5 {trace add command deleted removes traces} {
sl@0	1290	proc foo {} {}
sl@0	1291	trace add command foo rename traceCommand
sl@0	1292	proc foo {} {}
sl@0	1293	trace info command foo
sl@0	1294	} {}
sl@0	1295
sl@0	1296	namespace eval tc {}
sl@0	1297	proc tc::tcfoo {} {}
sl@0	1298	test trace-19.6 {trace add command rename in namespace} {
sl@0	1299	trace add command tc::tcfoo rename traceCommand
sl@0	1300	rename tc::tcfoo tc::tcbar
sl@0	1301	set info
sl@0	1302	} {::tc::tcfoo ::tc::tcbar rename}
sl@0	1303	test trace-19.7 {trace add command rename in namespace back again} {
sl@0	1304	rename tc::tcbar tc::tcfoo
sl@0	1305	set info
sl@0	1306	} {::tc::tcbar ::tc::tcfoo rename}
sl@0	1307	test trace-19.8 {trace add command rename in namespace to out of namespace} {
sl@0	1308	rename tc::tcfoo tcbar
sl@0	1309	set info
sl@0	1310	} {::tc::tcfoo ::tcbar rename}
sl@0	1311	test trace-19.9 {trace add command rename back into namespace} {
sl@0	1312	rename tcbar tc::tcfoo
sl@0	1313	set info
sl@0	1314	} {::tcbar ::tc::tcfoo rename}
sl@0	1315	test trace-19.10 {trace add command failed rename doesn't trigger trace} {
sl@0	1316	set info {}
sl@0	1317	proc foo {} {}
sl@0	1318	proc bar {} {}
sl@0	1319	trace add command foo {rename delete} traceCommand
sl@0	1320	catch {rename foo bar}
sl@0	1321	set info
sl@0	1322	} {}
sl@0	1323	catch {rename foo {}}
sl@0	1324	catch {rename bar {}}
sl@0	1325	test trace-19.11 {trace add command qualifies when renamed in namespace} {
sl@0	1326	set info {}
sl@0	1327	namespace eval tc {rename tcfoo tcbar}
sl@0	1328	set info
sl@0	1329	} {::tc::tcfoo ::tc::tcbar rename}
sl@0	1330
sl@0	1331	# Make sure it exists again
sl@0	1332	proc foo {} {}
sl@0	1333
sl@0	1334	test trace-20.1 {trace add command (delete option)} {
sl@0	1335	trace add command foo delete traceCommand
sl@0	1336	rename foo ""
sl@0	1337	set info
sl@0	1338	} {::foo {} delete}
sl@0	1339	test trace-20.2 {trace add command delete doesn't trace recreated commands} {
sl@0	1340	set info {}
sl@0	1341	proc foo {} {}
sl@0	1342	rename foo ""
sl@0	1343	set info
sl@0	1344	} {}
sl@0	1345	test trace-20.2.1 {trace add command delete trace info} {
sl@0	1346	proc foo {} {}
sl@0	1347	trace add command foo delete traceCommand
sl@0	1348	trace info command foo
sl@0	1349	} {{delete traceCommand}}
sl@0	1350	test trace-20.3 {trace add command implicit delete} {
sl@0	1351	proc foo {} {}
sl@0	1352	trace add command foo delete traceCommand
sl@0	1353	proc foo {} {}
sl@0	1354	set info
sl@0	1355	} {::foo {} delete}
sl@0	1356	test trace-20.3.1 {trace add command delete trace info} {
sl@0	1357	proc foo {} {}
sl@0	1358	trace info command foo
sl@0	1359	} {}
sl@0	1360	test trace-20.4 {trace add command rename followed by delete} {
sl@0	1361	set infotemp {}
sl@0	1362	proc foo {} {}
sl@0	1363	trace add command foo {rename delete} traceCommand
sl@0	1364	rename foo bar
sl@0	1365	lappend infotemp $info
sl@0	1366	rename bar {}
sl@0	1367	lappend infotemp $info
sl@0	1368	set info $infotemp
sl@0	1369	unset infotemp
sl@0	1370	set info
sl@0	1371	} {{::foo ::bar rename} {::bar {} delete}}
sl@0	1372	catch {rename foo {}}
sl@0	1373	catch {rename bar {}}
sl@0	1374
sl@0	1375	test trace-20.5 {trace add command rename and delete} {
sl@0	1376	set infotemp {}
sl@0	1377	set info {}
sl@0	1378	proc foo {} {}
sl@0	1379	trace add command foo {rename delete} traceCommand
sl@0	1380	rename foo bar
sl@0	1381	lappend infotemp $info
sl@0	1382	rename bar {}
sl@0	1383	lappend infotemp $info
sl@0	1384	set info $infotemp
sl@0	1385	unset infotemp
sl@0	1386	set info
sl@0	1387	} {{::foo ::bar rename} {::bar {} delete}}
sl@0	1388
sl@0	1389	test trace-20.6 {trace add command rename and delete in subinterp} {
sl@0	1390	set tc [interp create]
sl@0	1391	foreach p {traceCommand} {
sl@0	1392	$tc eval [list proc $p [info args $p] [info body $p]]
sl@0	1393	}
sl@0	1394	$tc eval [list set infotemp {}]
sl@0	1395	$tc eval [list set info {}]
sl@0	1396	$tc eval [list proc foo {} {}]
sl@0	1397	$tc eval [list trace add command foo {rename delete} traceCommand]
sl@0	1398	$tc eval [list rename foo bar]
sl@0	1399	$tc eval {lappend infotemp $info}
sl@0	1400	$tc eval [list rename bar {}]
sl@0	1401	$tc eval {lappend infotemp $info}
sl@0	1402	$tc eval {set info $infotemp}
sl@0	1403	$tc eval [list unset infotemp]
sl@0	1404	set info [$tc eval [list set info]]
sl@0	1405	interp delete $tc
sl@0	1406	set info
sl@0	1407	} {{::foo ::bar rename} {::bar {} delete}}
sl@0	1408
sl@0	1409	# I'd like it if this test could give 'foo {} d' as a result,
sl@0	1410	# but interp deletion means there is no interp to evaluate
sl@0	1411	# the trace in.
sl@0	1412	test trace-20.7 {trace add command delete in subinterp while being deleted} {
sl@0	1413	set info {}
sl@0	1414	set tc [interp create]
sl@0	1415	interp alias $tc traceCommand {} traceCommand
sl@0	1416	$tc eval [list proc foo {} {}]
sl@0	1417	$tc eval [list trace add command foo {rename delete} traceCommand]
sl@0	1418	interp delete $tc
sl@0	1419	set info
sl@0	1420	} {}
sl@0	1421
sl@0	1422	proc traceDelete {cmd old new op} {
sl@0	1423	eval trace remove command $cmd [lindex [trace info command $cmd] 0]
sl@0	1424	global info
sl@0	1425	set info [list $old $new $op]
sl@0	1426	}
sl@0	1427	proc traceCmdrename {cmd old new op} {
sl@0	1428	rename $old someothername
sl@0	1429	}
sl@0	1430	proc traceCmddelete {cmd old new op} {
sl@0	1431	rename $old ""
sl@0	1432	}
sl@0	1433	test trace-20.8 {trace delete while trace is active} {
sl@0	1434	set info {}
sl@0	1435	proc foo {} {}
sl@0	1436	catch {rename bar {}}
sl@0	1437	trace add command foo {rename delete} [list traceDelete foo]
sl@0	1438	rename foo bar
sl@0	1439	list [set info] [trace info command bar]
sl@0	1440	} {{::foo ::bar rename} {}}
sl@0	1441
sl@0	1442	test trace-20.9 {rename trace deletes command} {
sl@0	1443	set info {}
sl@0	1444	proc foo {} {}
sl@0	1445	catch {rename bar {}}
sl@0	1446	catch {rename someothername {}}
sl@0	1447	trace add command foo rename [list traceCmddelete foo]
sl@0	1448	rename foo bar
sl@0	1449	list [info commands foo] [info commands bar] [info commands someothername]
sl@0	1450	} {{} {} {}}
sl@0	1451
sl@0	1452	test trace-20.10 {rename trace renames command} {
sl@0	1453	set info {}
sl@0	1454	proc foo {} {}
sl@0	1455	catch {rename bar {}}
sl@0	1456	catch {rename someothername {}}
sl@0	1457	trace add command foo rename [list traceCmdrename foo]
sl@0	1458	rename foo bar
sl@0	1459	set info [list [info commands foo] [info commands bar] [info commands someothername]]
sl@0	1460	rename someothername {}
sl@0	1461	set info
sl@0	1462	} {{} {} someothername}
sl@0	1463
sl@0	1464	test trace-20.11 {delete trace deletes command} {
sl@0	1465	set info {}
sl@0	1466	proc foo {} {}
sl@0	1467	catch {rename bar {}}
sl@0	1468	catch {rename someothername {}}
sl@0	1469	trace add command foo delete [list traceCmddelete foo]
sl@0	1470	rename foo {}
sl@0	1471	list [info commands foo] [info commands bar] [info commands someothername]
sl@0	1472	} {{} {} {}}
sl@0	1473
sl@0	1474	test trace-20.12 {delete trace renames command} {
sl@0	1475	set info {}
sl@0	1476	proc foo {} {}
sl@0	1477	catch {rename bar {}}
sl@0	1478	catch {rename someothername {}}
sl@0	1479	trace add command foo delete [list traceCmdrename foo]
sl@0	1480	rename foo bar
sl@0	1481	rename bar {}
sl@0	1482	# None of these should exist.
sl@0	1483	list [info commands foo] [info commands bar] [info commands someothername]
sl@0	1484	} {{} {} {}}
sl@0	1485
sl@0	1486	test trace-20.13 {rename trace discards result [Bug 1355342]} {
sl@0	1487	proc foo {} {}
sl@0	1488	trace add command foo rename {set w Aha!;#}
sl@0	1489	list [rename foo bar] [rename bar {}]
sl@0	1490	} {{} {}}
sl@0	1491	test trace-20.14 {rename trace discards error result [Bug 1355342]} {
sl@0	1492	proc foo {} {}
sl@0	1493	trace add command foo rename {error}
sl@0	1494	list [rename foo bar] [rename bar {}]
sl@0	1495	} {{} {}}
sl@0	1496	test trace-20.15 {delete trace discards result [Bug 1355342]} {
sl@0	1497	proc foo {} {}
sl@0	1498	trace add command foo delete {set w Aha!;#}
sl@0	1499	rename foo {}
sl@0	1500	} {}
sl@0	1501	test trace-20.16 {delete trace discards error result [Bug 1355342]} {
sl@0	1502	proc foo {} {}
sl@0	1503	trace add command foo delete {error}
sl@0	1504	rename foo {}
sl@0	1505	} {}
sl@0	1506
sl@0	1507	proc foo {b} { set a $b }
sl@0	1508
sl@0	1509
sl@0	1510	# Delete arrays when done, so they can be re-used as scalars
sl@0	1511	# elsewhere.
sl@0	1512
sl@0	1513	catch {unset x}
sl@0	1514	catch {unset y}
sl@0	1515
sl@0	1516	# Delete procedures when done, so we don't clash with other tests
sl@0	1517	# (e.g. foobar will clash with 'unknown' tests).
sl@0	1518	catch {rename foobar {}}
sl@0	1519	catch {rename foo {}}
sl@0	1520	catch {rename bar {}}
sl@0	1521
sl@0	1522	proc foo {a} {
sl@0	1523	set b $a
sl@0	1524	}
sl@0	1525
sl@0	1526	proc traceExecute {args} {
sl@0	1527	global info
sl@0	1528	lappend info $args
sl@0	1529	}
sl@0	1530
sl@0	1531	test trace-21.1 {trace execution: enter} {
sl@0	1532	set info {}
sl@0	1533	trace add execution foo enter [list traceExecute foo]
sl@0	1534	foo 1
sl@0	1535	trace remove execution foo enter [list traceExecute foo]
sl@0	1536	set info
sl@0	1537	} {{foo {foo 1} enter}}
sl@0	1538
sl@0	1539	test trace-21.2 {trace exeuction: leave} {
sl@0	1540	set info {}
sl@0	1541	trace add execution foo leave [list traceExecute foo]
sl@0	1542	foo 2
sl@0	1543	trace remove execution foo leave [list traceExecute foo]
sl@0	1544	set info
sl@0	1545	} {{foo {foo 2} 0 2 leave}}
sl@0	1546
sl@0	1547	test trace-21.3 {trace exeuction: enter, leave} {
sl@0	1548	set info {}
sl@0	1549	trace add execution foo {enter leave} [list traceExecute foo]
sl@0	1550	foo 3
sl@0	1551	trace remove execution foo {enter leave} [list traceExecute foo]
sl@0	1552	set info
sl@0	1553	} {{foo {foo 3} enter} {foo {foo 3} 0 3 leave}}
sl@0	1554
sl@0	1555	test trace-21.4 {trace execution: enter, leave, enterstep} {
sl@0	1556	set info {}
sl@0	1557	trace add execution foo {enter leave enterstep} [list traceExecute foo]
sl@0	1558	foo 3
sl@0	1559	trace remove execution foo {enter leave enterstep} [list traceExecute foo]
sl@0	1560	set info
sl@0	1561	} {{foo {foo 3} enter} {foo {set b 3} enterstep} {foo {foo 3} 0 3 leave}}
sl@0	1562
sl@0	1563	test trace-21.5 {trace execution: enter, leave, enterstep, leavestep} {
sl@0	1564	set info {}
sl@0	1565	trace add execution foo {enter leave enterstep leavestep} [list traceExecute foo]
sl@0	1566	foo 3
sl@0	1567	trace remove execution foo {enter leave enterstep leavestep} [list traceExecute foo]
sl@0	1568	set info
sl@0	1569	} {{foo {foo 3} enter} {foo {set b 3} enterstep} {foo {set b 3} 0 3 leavestep} {foo {foo 3} 0 3 leave}}
sl@0	1570
sl@0	1571	test trace-21.6 {trace execution: enterstep, leavestep} {
sl@0	1572	set info {}
sl@0	1573	trace add execution foo {enterstep leavestep} [list traceExecute foo]
sl@0	1574	foo 3
sl@0	1575	trace remove execution foo {enterstep leavestep} [list traceExecute foo]
sl@0	1576	set info
sl@0	1577	} {{foo {set b 3} enterstep} {foo {set b 3} 0 3 leavestep}}
sl@0	1578
sl@0	1579	test trace-21.7 {trace execution: enterstep} {
sl@0	1580	set info {}
sl@0	1581	trace add execution foo {enterstep} [list traceExecute foo]
sl@0	1582	foo 3
sl@0	1583	trace remove execution foo {enterstep} [list traceExecute foo]
sl@0	1584	set info
sl@0	1585	} {{foo {set b 3} enterstep}}
sl@0	1586
sl@0	1587	test trace-21.8 {trace execution: leavestep} {
sl@0	1588	set info {}
sl@0	1589	trace add execution foo {leavestep} [list traceExecute foo]
sl@0	1590	foo 3
sl@0	1591	trace remove execution foo {leavestep} [list traceExecute foo]
sl@0	1592	set info
sl@0	1593	} {{foo {set b 3} 0 3 leavestep}}
sl@0	1594
sl@0	1595	test trace-21.9 {trace execution: TCL_EVAL_GLOBAL} testevalobjv {
sl@0	1596	trace add execution foo enter soom
sl@0	1597	proc ::soom args {lappend ::info SUCCESS [info level]}
sl@0	1598	set ::info {}
sl@0	1599	namespace eval test_ns_1 {
sl@0	1600	proc soom args {lappend ::info FAIL [info level]}
sl@0	1601	# [testevalobjv 1 ...] ought to produce the same
sl@0	1602	# results as [uplevel #0 ...].
sl@0	1603	testevalobjv 1 foo x
sl@0	1604	uplevel #0 foo x
sl@0	1605	}
sl@0	1606	namespace delete test_ns_1
sl@0	1607	trace remove execution foo enter soom
sl@0	1608	set ::info
sl@0	1609	} {SUCCESS 1 SUCCESS 1}
sl@0	1610
sl@0	1611	test trace-21.10 {trace execution: TCL_EVAL_GLOBAL} testevalobjv {
sl@0	1612	trace add execution foo leave soom
sl@0	1613	proc ::soom args {lappend ::info SUCCESS [info level]}
sl@0	1614	set ::info {}
sl@0	1615	namespace eval test_ns_1 {
sl@0	1616	proc soom args {lappend ::info FAIL [info level]}
sl@0	1617	# [testevalobjv 1 ...] ought to produce the same
sl@0	1618	# results as [uplevel #0 ...].
sl@0	1619	testevalobjv 1 foo x
sl@0	1620	uplevel #0 foo x
sl@0	1621	}
sl@0	1622	namespace delete test_ns_1
sl@0	1623	trace remove execution foo leave soom
sl@0	1624	set ::info
sl@0	1625	} {SUCCESS 1 SUCCESS 1}
sl@0	1626
sl@0	1627	test trace-21.11 {trace execution and alias} -setup {
sl@0	1628	set res {}
sl@0	1629	proc ::x {} {return ::}
sl@0	1630	namespace eval a {}
sl@0	1631	proc ::a::x {} {return ::a}
sl@0	1632	interp alias {} y {} x
sl@0	1633	} -body {
sl@0	1634	lappend res [namespace eval ::a y]
sl@0	1635	trace add execution ::x enter {
sl@0	1636	rename ::x {}
sl@0	1637	proc ::x {} {return ::}
sl@0	1638	#}
sl@0	1639	lappend res [namespace eval ::a y]
sl@0	1640	} -cleanup {
sl@0	1641	namespace delete a
sl@0	1642	rename ::x {}
sl@0	1643	} -result {:: ::}
sl@0	1644
sl@0	1645	proc factorial {n} {
sl@0	1646	if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }
sl@0	1647	return 1
sl@0	1648	}
sl@0	1649
sl@0	1650	test trace-22.1 {recursive(1) trace execution: enter} {
sl@0	1651	set info {}
sl@0	1652	trace add execution factorial {enter} [list traceExecute factorial]
sl@0	1653	factorial 1
sl@0	1654	trace remove execution factorial {enter} [list traceExecute factorial]
sl@0	1655	set info
sl@0	1656	} {{factorial {factorial 1} enter}}
sl@0	1657
sl@0	1658	test trace-22.2 {recursive(2) trace execution: enter} {
sl@0	1659	set info {}
sl@0	1660	trace add execution factorial {enter} [list traceExecute factorial]
sl@0	1661	factorial 2
sl@0	1662	trace remove execution factorial {enter} [list traceExecute factorial]
sl@0	1663	set info
sl@0	1664	} {{factorial {factorial 2} enter} {factorial {factorial 1} enter}}
sl@0	1665
sl@0	1666	test trace-22.3 {recursive(3) trace execution: enter} {
sl@0	1667	set info {}
sl@0	1668	trace add execution factorial {enter} [list traceExecute factorial]
sl@0	1669	factorial 3
sl@0	1670	trace remove execution factorial {enter} [list traceExecute factorial]
sl@0	1671	set info
sl@0	1672	} {{factorial {factorial 3} enter} {factorial {factorial 2} enter} {factorial {factorial 1} enter}}
sl@0	1673
sl@0	1674	test trace-23.1 {recursive(1) trace execution: enter, leave, enterstep, leavestep} {
sl@0	1675	set info {}
sl@0	1676	trace add execution factorial {enter leave enterstep leavestep} [list traceExecute]
sl@0	1677	factorial 1
sl@0	1678	trace remove execution factorial {enter leave enterstep leavestep} [list traceExecute]
sl@0	1679	join $info "\n"
sl@0	1680	} {{factorial 1} enter
sl@0	1681	{if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} enterstep
sl@0	1682	{if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} 0 {} leavestep
sl@0	1683	{return 1} enterstep
sl@0	1684	{return 1} 2 1 leavestep
sl@0	1685	{factorial 1} 0 1 leave}
sl@0	1686
sl@0	1687	test trace-23.2 {recursive(2) trace execution: enter, leave, enterstep, leavestep} {
sl@0	1688	set info {}
sl@0	1689	trace add execution factorial {enter leave enterstep leavestep} [list traceExecute]
sl@0	1690	factorial 2
sl@0	1691	trace remove execution factorial {enter leave enterstep leavestep} [list traceExecute]
sl@0	1692	join $info "\n"
sl@0	1693	} {{factorial 2} enter
sl@0	1694	{if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} enterstep
sl@0	1695	{expr {$n * [factorial [expr {$n -1 }]]}} enterstep
sl@0	1696	{expr {$n -1 }} enterstep
sl@0	1697	{expr {$n -1 }} 0 1 leavestep
sl@0	1698	{factorial 1} enterstep
sl@0	1699	{factorial 1} enter
sl@0	1700	{if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} enterstep
sl@0	1701	{if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} 0 {} leavestep
sl@0	1702	{return 1} enterstep
sl@0	1703	{return 1} 2 1 leavestep
sl@0	1704	{factorial 1} 0 1 leave
sl@0	1705	{factorial 1} 0 1 leavestep
sl@0	1706	{expr {$n * [factorial [expr {$n -1 }]]}} 0 2 leavestep
sl@0	1707	{return 2} enterstep
sl@0	1708	{return 2} 2 2 leavestep
sl@0	1709	{if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} 2 2 leavestep
sl@0	1710	{factorial 2} 0 2 leave}
sl@0	1711
sl@0	1712	test trace-23.3 {recursive(3) trace execution: enter, leave, enterstep, leavestep} {
sl@0	1713	set info {}
sl@0	1714	trace add execution factorial {enter leave enterstep leavestep} [list traceExecute]
sl@0	1715	factorial 3
sl@0	1716	trace remove execution factorial {enter leave enterstep leavestep} [list traceExecute]
sl@0	1717	join $info "\n"
sl@0	1718	} {{factorial 3} enter
sl@0	1719	{if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} enterstep
sl@0	1720	{expr {$n * [factorial [expr {$n -1 }]]}} enterstep
sl@0	1721	{expr {$n -1 }} enterstep
sl@0	1722	{expr {$n -1 }} 0 2 leavestep
sl@0	1723	{factorial 2} enterstep
sl@0	1724	{factorial 2} enter
sl@0	1725	{if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} enterstep
sl@0	1726	{expr {$n * [factorial [expr {$n -1 }]]}} enterstep
sl@0	1727	{expr {$n -1 }} enterstep
sl@0	1728	{expr {$n -1 }} 0 1 leavestep
sl@0	1729	{factorial 1} enterstep
sl@0	1730	{factorial 1} enter
sl@0	1731	{if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} enterstep
sl@0	1732	{if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} 0 {} leavestep
sl@0	1733	{return 1} enterstep
sl@0	1734	{return 1} 2 1 leavestep
sl@0	1735	{factorial 1} 0 1 leave
sl@0	1736	{factorial 1} 0 1 leavestep
sl@0	1737	{expr {$n * [factorial [expr {$n -1 }]]}} 0 2 leavestep
sl@0	1738	{return 2} enterstep
sl@0	1739	{return 2} 2 2 leavestep
sl@0	1740	{if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} 2 2 leavestep
sl@0	1741	{factorial 2} 0 2 leave
sl@0	1742	{factorial 2} 0 2 leavestep
sl@0	1743	{expr {$n * [factorial [expr {$n -1 }]]}} 0 6 leavestep
sl@0	1744	{return 6} enterstep
sl@0	1745	{return 6} 2 6 leavestep
sl@0	1746	{if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} 2 6 leavestep
sl@0	1747	{factorial 3} 0 6 leave}
sl@0	1748
sl@0	1749	proc traceDelete {cmd args} {
sl@0	1750	eval trace remove execution $cmd [lindex [trace info execution $cmd] 0]
sl@0	1751	global info
sl@0	1752	set info $args
sl@0	1753	}
sl@0	1754
sl@0	1755	test trace-24.1 {delete trace during enter trace} {
sl@0	1756	set info {}
sl@0	1757	trace add execution foo enter [list traceDelete foo]
sl@0	1758	foo 1
sl@0	1759	list $info [catch {trace info execution foo} res] $res
sl@0	1760	} {{{foo 1} enter} 0 {}}
sl@0	1761
sl@0	1762	test trace-24.2 {delete trace during leave trace} {
sl@0	1763	set info {}
sl@0	1764	trace add execution foo leave [list traceDelete foo]
sl@0	1765	foo 1
sl@0	1766	list $info [catch {trace info execution foo} res] $res
sl@0	1767	} {{{foo 1} 0 1 leave} 0 {}}
sl@0	1768
sl@0	1769	test trace-24.3 {delete trace during enter-leave trace} {
sl@0	1770	set info {}
sl@0	1771	trace add execution foo {enter leave} [list traceDelete foo]
sl@0	1772	foo 1
sl@0	1773	list $info [catch {trace info execution foo} res] $res
sl@0	1774	} {{{foo 1} enter} 0 {}}
sl@0	1775
sl@0	1776	test trace-24.4 {delete trace during all exec traces} {
sl@0	1777	set info {}
sl@0	1778	trace add execution foo {enter leave enterstep leavestep} [list traceDelete foo]
sl@0	1779	foo 1
sl@0	1780	list $info [catch {trace info execution foo} res] $res
sl@0	1781	} {{{foo 1} enter} 0 {}}
sl@0	1782
sl@0	1783	test trace-24.5 {delete trace during all exec traces except enter} {
sl@0	1784	set info {}
sl@0	1785	trace add execution foo {leave enterstep leavestep} [list traceDelete foo]
sl@0	1786	foo 1
sl@0	1787	list $info [catch {trace info execution foo} res] $res
sl@0	1788	} {{{set b 1} enterstep} 0 {}}
sl@0	1789
sl@0	1790	proc traceDelete {cmd args} {
sl@0	1791	rename $cmd {}
sl@0	1792	global info
sl@0	1793	set info $args
sl@0	1794	}
sl@0	1795
sl@0	1796	proc foo {a} {
sl@0	1797	set b $a
sl@0	1798	}
sl@0	1799
sl@0	1800	test trace-25.1 {delete command during enter trace} {
sl@0	1801	set info {}
sl@0	1802	trace add execution foo enter [list traceDelete foo]
sl@0	1803	catch {foo 1} err
sl@0	1804	list $err $info [catch {trace info execution foo} res] $res
sl@0	1805	} {{invalid command name "foo"} {{foo 1} enter} 1 {unknown command "foo"}}
sl@0	1806
sl@0	1807	proc foo {a} {
sl@0	1808	set b $a
sl@0	1809	}
sl@0	1810
sl@0	1811	test trace-25.2 {delete command during leave trace} {
sl@0	1812	set info {}
sl@0	1813	trace add execution foo leave [list traceDelete foo]
sl@0	1814	foo 1
sl@0	1815	list $info [catch {trace info execution foo} res] $res
sl@0	1816	} {{{foo 1} 0 1 leave} 1 {unknown command "foo"}}
sl@0	1817
sl@0	1818	proc foo {a} {
sl@0	1819	set b $a
sl@0	1820	}
sl@0	1821
sl@0	1822	test trace-25.3 {delete command during enter then leave trace} {
sl@0	1823	set info {}
sl@0	1824	trace add execution foo enter [list traceDelete foo]
sl@0	1825	trace add execution foo leave [list traceDelete foo]
sl@0	1826	catch {foo 1} err
sl@0	1827	list $err $info [catch {trace info execution foo} res] $res
sl@0	1828	} {{invalid command name "foo"} {{foo 1} enter} 1 {unknown command "foo"}}
sl@0	1829
sl@0	1830	proc foo {a} {
sl@0	1831	set b $a
sl@0	1832	}
sl@0	1833	proc traceExecute2 {args} {
sl@0	1834	global info
sl@0	1835	lappend info $args
sl@0	1836	}
sl@0	1837
sl@0	1838	# This shows the peculiar consequences of having two traces
sl@0	1839	# at the same time: as well as tracing the procedure you want
sl@0	1840	test trace-25.4 {order dependencies of two enter traces} {
sl@0	1841	set info {}
sl@0	1842	trace add execution foo enter [list traceExecute traceExecute]
sl@0	1843	trace add execution foo enter [list traceExecute2 traceExecute2]
sl@0	1844	catch {foo 1} err
sl@0	1845	trace remove execution foo enter [list traceExecute traceExecute]
sl@0	1846	trace remove execution foo enter [list traceExecute2 traceExecute2]
sl@0	1847	join [list $err [join $info \n] [trace info execution foo]] "\n"
sl@0	1848	} {1
sl@0	1849	traceExecute2 {foo 1} enter
sl@0	1850	traceExecute {foo 1} enter
sl@0	1851	}
sl@0	1852
sl@0	1853	test trace-25.5 {order dependencies of two step traces} {
sl@0	1854	set info {}
sl@0	1855	trace add execution foo enterstep [list traceExecute traceExecute]
sl@0	1856	trace add execution foo enterstep [list traceExecute2 traceExecute2]
sl@0	1857	catch {foo 1} err
sl@0	1858	trace remove execution foo enterstep [list traceExecute traceExecute]
sl@0	1859	trace remove execution foo enterstep [list traceExecute2 traceExecute2]
sl@0	1860	join [list $err [join $info \n] [trace info execution foo]] "\n"
sl@0	1861	} {1
sl@0	1862	traceExecute2 {set b 1} enterstep
sl@0	1863	traceExecute {set b 1} enterstep
sl@0	1864	}
sl@0	1865
sl@0	1866	# We don't want the result string (5th argument), or the results
sl@0	1867	# will get unmanageable.
sl@0	1868	proc tracePostExecute {args} {
sl@0	1869	global info
sl@0	1870	lappend info [concat [lrange $args 0 2] [lindex $args 4]]
sl@0	1871	}
sl@0	1872	proc tracePostExecute2 {args} {
sl@0	1873	global info
sl@0	1874	lappend info [concat [lrange $args 0 2] [lindex $args 4]]
sl@0	1875	}
sl@0	1876
sl@0	1877	test trace-25.6 {order dependencies of two leave traces} {
sl@0	1878	set info {}
sl@0	1879	trace add execution foo leave [list tracePostExecute tracePostExecute]
sl@0	1880	trace add execution foo leave [list tracePostExecute2 tracePostExecute2]
sl@0	1881	catch {foo 1} err
sl@0	1882	trace remove execution foo leave [list tracePostExecute tracePostExecute]
sl@0	1883	trace remove execution foo leave [list tracePostExecute2 tracePostExecute2]
sl@0	1884	join [list $err [join $info \n] [trace info execution foo]] "\n"
sl@0	1885	} {1
sl@0	1886	tracePostExecute {foo 1} 0 leave
sl@0	1887	tracePostExecute2 {foo 1} 0 leave
sl@0	1888	}
sl@0	1889
sl@0	1890	test trace-25.7 {order dependencies of two leavestep traces} {
sl@0	1891	set info {}
sl@0	1892	trace add execution foo leavestep [list tracePostExecute tracePostExecute]
sl@0	1893	trace add execution foo leavestep [list tracePostExecute2 tracePostExecute2]
sl@0	1894	catch {foo 1} err
sl@0	1895	trace remove execution foo leavestep [list tracePostExecute tracePostExecute]
sl@0	1896	trace remove execution foo leavestep [list tracePostExecute2 tracePostExecute2]
sl@0	1897	join [list $err [join $info \n] [trace info execution foo]] "\n"
sl@0	1898	} {1
sl@0	1899	tracePostExecute {set b 1} 0 leavestep
sl@0	1900	tracePostExecute2 {set b 1} 0 leavestep
sl@0	1901	}
sl@0	1902
sl@0	1903	proc foo {a} {
sl@0	1904	set b $a
sl@0	1905	}
sl@0	1906
sl@0	1907	proc traceDelete {cmd args} {
sl@0	1908	rename $cmd {}
sl@0	1909	global info
sl@0	1910	set info $args
sl@0	1911	}
sl@0	1912
sl@0	1913	test trace-25.8 {delete command during enter leave and enter/leave-step traces} {
sl@0	1914	set info {}
sl@0	1915	trace add execution foo enter [list traceDelete foo]
sl@0	1916	trace add execution foo leave [list traceDelete foo]
sl@0	1917	trace add execution foo enterstep [list traceDelete foo]
sl@0	1918	trace add execution foo leavestep [list traceDelete foo]
sl@0	1919	catch {foo 1} err
sl@0	1920	list $err $info [catch {trace info execution foo} res] $res
sl@0	1921	} {{invalid command name "foo"} {{foo 1} enter} 1 {unknown command "foo"}}
sl@0	1922
sl@0	1923	proc foo {a} {
sl@0	1924	set b $a
sl@0	1925	}
sl@0	1926
sl@0	1927	test trace-25.9 {delete command during enter leave and leavestep traces} {
sl@0	1928	set info {}
sl@0	1929	trace add execution foo enter [list traceDelete foo]
sl@0	1930	trace add execution foo leave [list traceDelete foo]
sl@0	1931	trace add execution foo leavestep [list traceDelete foo]
sl@0	1932	catch {foo 1} err
sl@0	1933	list $err $info [catch {trace info execution foo} res] $res
sl@0	1934	} {{invalid command name "foo"} {{foo 1} enter} 1 {unknown command "foo"}}
sl@0	1935
sl@0	1936	proc foo {a} {
sl@0	1937	set b $a
sl@0	1938	}
sl@0	1939
sl@0	1940	test trace-25.10 {delete command during leave and leavestep traces} {
sl@0	1941	set info {}
sl@0	1942	trace add execution foo leave [list traceDelete foo]
sl@0	1943	trace add execution foo leavestep [list traceDelete foo]
sl@0	1944	catch {foo 1} err
sl@0	1945	list $err $info [catch {trace info execution foo} res] $res
sl@0	1946	} {1 {{set b 1} 0 1 leavestep} 1 {unknown command "foo"}}
sl@0	1947
sl@0	1948	proc foo {a} {
sl@0	1949	set b $a
sl@0	1950	}
sl@0	1951
sl@0	1952	test trace-25.11 {delete command during enter and enterstep traces} {
sl@0	1953	set info {}
sl@0	1954	trace add execution foo enter [list traceDelete foo]
sl@0	1955	trace add execution foo enterstep [list traceDelete foo]
sl@0	1956	catch {foo 1} err
sl@0	1957	list $err $info [catch {trace info execution foo} res] $res
sl@0	1958	} {{invalid command name "foo"} {{foo 1} enter} 1 {unknown command "foo"}}
sl@0	1959
sl@0	1960	test trace-26.1 {trace targetCmd when invoked through an alias} {
sl@0	1961	proc foo {args} {
sl@0	1962	set b $args
sl@0	1963	}
sl@0	1964	set info {}
sl@0	1965	trace add execution foo enter [list traceExecute foo]
sl@0	1966	interp alias {} bar {} foo 1
sl@0	1967	bar 2
sl@0	1968	trace remove execution foo enter [list traceExecute foo]
sl@0	1969	set info
sl@0	1970	} {{foo {foo 1 2} enter}}
sl@0	1971	test trace-26.2 {trace targetCmd when invoked through an alias} {
sl@0	1972	proc foo {args} {
sl@0	1973	set b $args
sl@0	1974	}
sl@0	1975	set info {}
sl@0	1976	trace add execution foo enter [list traceExecute foo]
sl@0	1977	interp create child
sl@0	1978	interp alias child bar {} foo 1
sl@0	1979	child eval bar 2
sl@0	1980	interp delete child
sl@0	1981	trace remove execution foo enter [list traceExecute foo]
sl@0	1982	set info
sl@0	1983	} {{foo {foo 1 2} enter}}
sl@0	1984
sl@0	1985	test trace-27.1 {memory leak in rename trace (604609)} {
sl@0	1986	catch {rename bar {}}
sl@0	1987	proc foo {} {error foo}
sl@0	1988	trace add command foo rename {rename foo "" ;#}
sl@0	1989	rename foo bar
sl@0	1990	info commands foo
sl@0	1991	} {}
sl@0	1992
sl@0	1993	test trace-27.2 {command trace remove nonsense} {
sl@0	1994	list [catch {trace remove command thisdoesntexist \
sl@0	1995	{delete rename} bar} res] $res
sl@0	1996	} {1 {unknown command "thisdoesntexist"}}
sl@0	1997
sl@0	1998	test trace-27.3 {command trace info nonsense} {
sl@0	1999	list [catch {trace info command thisdoesntexist} res] $res
sl@0	2000	} {1 {unknown command "thisdoesntexist"}}
sl@0	2001
sl@0	2002
sl@0	2003	test trace-28.1 {enterstep and leavestep traces with update idletasks (615043)} {
sl@0	2004	catch {rename foo {}}
sl@0	2005	proc foo {} {
sl@0	2006	set a 1
sl@0	2007	update idletasks
sl@0	2008	set b 1
sl@0	2009	}
sl@0	2010
sl@0	2011	set info {}
sl@0	2012	trace add execution foo {enter enterstep leavestep leave} \
sl@0	2013	[list traceExecute foo]
sl@0	2014	update
sl@0	2015	after idle {set a "idle"}
sl@0	2016	foo
sl@0	2017
sl@0	2018	trace remove execution foo {enter enterstep leavestep leave} \
sl@0	2019	[list traceExecute foo]
sl@0	2020	rename foo {}
sl@0	2021	catch {unset a}
sl@0	2022	join $info "\n"
sl@0	2023	} {foo foo enter
sl@0	2024	foo {set a 1} enterstep
sl@0	2025	foo {set a 1} 0 1 leavestep
sl@0	2026	foo {update idletasks} enterstep
sl@0	2027	foo {set a idle} enterstep
sl@0	2028	foo {set a idle} 0 idle leavestep
sl@0	2029	foo {update idletasks} 0 {} leavestep
sl@0	2030	foo {set b 1} enterstep
sl@0	2031	foo {set b 1} 0 1 leavestep
sl@0	2032	foo foo 0 1 leave}
sl@0	2033
sl@0	2034	test trace-28.2 {exec traces with 'error'} {
sl@0	2035	set info {}
sl@0	2036	set res {}
sl@0	2037
sl@0	2038	proc foo {} {
sl@0	2039	if {[catch {bar}]} {
sl@0	2040	return "error"
sl@0	2041	} else {
sl@0	2042	return "ok"
sl@0	2043	}
sl@0	2044	}
sl@0	2045
sl@0	2046	proc bar {} { error "msg" }
sl@0	2047
sl@0	2048	lappend res [foo]
sl@0	2049
sl@0	2050	trace add execution foo {enter enterstep leave leavestep} \
sl@0	2051	[list traceExecute foo]
sl@0	2052
sl@0	2053	# With the trace active
sl@0	2054
sl@0	2055	lappend res [foo]
sl@0	2056
sl@0	2057	trace remove execution foo {enter enterstep leave leavestep} \
sl@0	2058	[list traceExecute foo]
sl@0	2059
sl@0	2060	list $res [join $info \n]
sl@0	2061	} {{error error} {foo foo enter
sl@0	2062	foo {if {[catch {bar}]} {
sl@0	2063	return "error"
sl@0	2064	} else {
sl@0	2065	return "ok"
sl@0	2066	}} enterstep
sl@0	2067	foo {catch bar} enterstep
sl@0	2068	foo bar enterstep
sl@0	2069	foo {error msg} enterstep
sl@0	2070	foo {error msg} 1 msg leavestep
sl@0	2071	foo bar 1 msg leavestep
sl@0	2072	foo {catch bar} 0 1 leavestep
sl@0	2073	foo {return error} enterstep
sl@0	2074	foo {return error} 2 error leavestep
sl@0	2075	foo {if {[catch {bar}]} {
sl@0	2076	return "error"
sl@0	2077	} else {
sl@0	2078	return "ok"
sl@0	2079	}} 2 error leavestep
sl@0	2080	foo foo 0 error leave}}
sl@0	2081
sl@0	2082	test trace-28.3 {exec traces with 'return -code error'} {
sl@0	2083	set info {}
sl@0	2084	set res {}
sl@0	2085
sl@0	2086	proc foo {} {
sl@0	2087	if {[catch {bar}]} {
sl@0	2088	return "error"
sl@0	2089	} else {
sl@0	2090	return "ok"
sl@0	2091	}
sl@0	2092	}
sl@0	2093
sl@0	2094	proc bar {} { return -code error "msg" }
sl@0	2095
sl@0	2096	lappend res [foo]
sl@0	2097
sl@0	2098	trace add execution foo {enter enterstep leave leavestep} \
sl@0	2099	[list traceExecute foo]
sl@0	2100
sl@0	2101	# With the trace active
sl@0	2102
sl@0	2103	lappend res [foo]
sl@0	2104
sl@0	2105	trace remove execution foo {enter enterstep leave leavestep} \
sl@0	2106	[list traceExecute foo]
sl@0	2107
sl@0	2108	list $res [join $info \n]
sl@0	2109	} {{error error} {foo foo enter
sl@0	2110	foo {if {[catch {bar}]} {
sl@0	2111	return "error"
sl@0	2112	} else {
sl@0	2113	return "ok"
sl@0	2114	}} enterstep
sl@0	2115	foo {catch bar} enterstep
sl@0	2116	foo bar enterstep
sl@0	2117	foo {return -code error msg} enterstep
sl@0	2118	foo {return -code error msg} 2 msg leavestep
sl@0	2119	foo bar 1 msg leavestep
sl@0	2120	foo {catch bar} 0 1 leavestep
sl@0	2121	foo {return error} enterstep
sl@0	2122	foo {return error} 2 error leavestep
sl@0	2123	foo {if {[catch {bar}]} {
sl@0	2124	return "error"
sl@0	2125	} else {
sl@0	2126	return "ok"
sl@0	2127	}} 2 error leavestep
sl@0	2128	foo foo 0 error leave}}
sl@0	2129
sl@0	2130	test trace-28.4 {exec traces in slave with 'return -code error'} {
sl@0	2131	interp create slave
sl@0	2132	interp alias slave traceExecute {} traceExecute
sl@0	2133	set info {}
sl@0	2134	set res [interp eval slave {
sl@0	2135	set info {}
sl@0	2136	set res {}
sl@0	2137
sl@0	2138	proc foo {} {
sl@0	2139	if {[catch {bar}]} {
sl@0	2140	return "error"
sl@0	2141	} else {
sl@0	2142	return "ok"
sl@0	2143	}
sl@0	2144	}
sl@0	2145
sl@0	2146	proc bar {} { return -code error "msg" }
sl@0	2147
sl@0	2148	lappend res [foo]
sl@0	2149
sl@0	2150	trace add execution foo {enter enterstep leave leavestep} \
sl@0	2151	[list traceExecute foo]
sl@0	2152
sl@0	2153	# With the trace active
sl@0	2154
sl@0	2155	lappend res [foo]
sl@0	2156
sl@0	2157	trace remove execution foo {enter enterstep leave leavestep} \
sl@0	2158	[list traceExecute foo]
sl@0	2159
sl@0	2160	list $res
sl@0	2161	}]
sl@0	2162	interp delete slave
sl@0	2163	lappend res [join $info \n]
sl@0	2164	} {{error error} {foo foo enter
sl@0	2165	foo {if {[catch {bar}]} {
sl@0	2166	return "error"
sl@0	2167	} else {
sl@0	2168	return "ok"
sl@0	2169	}} enterstep
sl@0	2170	foo {catch bar} enterstep
sl@0	2171	foo bar enterstep
sl@0	2172	foo {return -code error msg} enterstep
sl@0	2173	foo {return -code error msg} 2 msg leavestep
sl@0	2174	foo bar 1 msg leavestep
sl@0	2175	foo {catch bar} 0 1 leavestep
sl@0	2176	foo {return error} enterstep
sl@0	2177	foo {return error} 2 error leavestep
sl@0	2178	foo {if {[catch {bar}]} {
sl@0	2179	return "error"
sl@0	2180	} else {
sl@0	2181	return "ok"
sl@0	2182	}} 2 error leavestep
sl@0	2183	foo foo 0 error leave}}
sl@0	2184
sl@0	2185	test trace-28.5 {exec traces} {
sl@0	2186	set info {}
sl@0	2187	proc foo {args} { set a 1 }
sl@0	2188	trace add execution foo {enter enterstep leave leavestep} \
sl@0	2189	[list traceExecute foo]
sl@0	2190	after idle [list foo test-28.4]
sl@0	2191	update
sl@0	2192	# Complicated way of removing traces
sl@0	2193	set ti [lindex [eval [list trace info execution ::foo]] 0]
sl@0	2194	if {[llength $ti]} {
sl@0	2195	eval [concat [list trace remove execution foo] $ti]
sl@0	2196	}
sl@0	2197	join $info \n
sl@0	2198	} {foo {foo test-28.4} enter
sl@0	2199	foo {set a 1} enterstep
sl@0	2200	foo {set a 1} 0 1 leavestep
sl@0	2201	foo {foo test-28.4} 0 1 leave}
sl@0	2202
sl@0	2203	test trace-28.6 {exec traces firing order} {
sl@0	2204	set info {}
sl@0	2205	proc enterStep {cmd op} {lappend ::info "enter $cmd/$op"}
sl@0	2206	proc leaveStep {cmd code result op} {lappend ::info "leave $cmd/$code/$result/$op"}
sl@0	2207
sl@0	2208	proc foo x {
sl@0	2209	set b x=$x
sl@0	2210	incr x
sl@0	2211	}
sl@0	2212	trace add execution foo enterstep enterStep
sl@0	2213	trace add execution foo leavestep leaveStep
sl@0	2214	foo 42
sl@0	2215	rename foo {}
sl@0	2216	join $info \n
sl@0	2217	} {enter set b x=42/enterstep
sl@0	2218	leave set b x=42/0/x=42/leavestep
sl@0	2219	enter incr x/enterstep
sl@0	2220	leave incr x/0/43/leavestep}
sl@0	2221
sl@0	2222	test trace-28.7 {exec trace information} {
sl@0	2223	set info {}
sl@0	2224	proc foo x { incr x }
sl@0	2225	proc bar {args} {}
sl@0	2226	trace add execution foo {enter leave enterstep leavestep} bar
sl@0	2227	set info [trace info execution foo]
sl@0	2228	trace remove execution foo {enter leave enterstep leavestep} bar
sl@0	2229	} {}
sl@0	2230
sl@0	2231	test trace-28.8 {exec trace remove nonsense} {
sl@0	2232	list [catch {trace remove execution thisdoesntexist \
sl@0	2233	{enter leave enterstep leavestep} bar} res] $res
sl@0	2234	} {1 {unknown command "thisdoesntexist"}}
sl@0	2235
sl@0	2236	test trace-28.9 {exec trace info nonsense} {
sl@0	2237	list [catch {trace info execution thisdoesntexist} res] $res
sl@0	2238	} {1 {unknown command "thisdoesntexist"}}
sl@0	2239
sl@0	2240	test trace-28.10 {exec trace info nonsense} {
sl@0	2241	list [catch {trace remove execution} res] $res
sl@0	2242	} {1 {wrong # args: should be "trace remove execution name opList command"}}
sl@0	2243
sl@0	2244	# Missing test number to keep in sync with the 8.5 branch
sl@0	2245	# (want to backport those tests?)
sl@0	2246
sl@0	2247	test trace-31.1 {command and execution traces shared struct} {
sl@0	2248	# Tcl Bug 807243
sl@0	2249	proc foo {} {}
sl@0	2250	trace add command foo delete foo
sl@0	2251	trace add execution foo enter foo
sl@0	2252	set result [trace info command foo]
sl@0	2253	trace remove command foo delete foo
sl@0	2254	trace remove execution foo enter foo
sl@0	2255	rename foo {}
sl@0	2256	set result
sl@0	2257	} [list [list delete foo]]
sl@0	2258	test trace-31.2 {command and execution traces shared struct} {
sl@0	2259	# Tcl Bug 807243
sl@0	2260	proc foo {} {}
sl@0	2261	trace add command foo delete foo
sl@0	2262	trace add execution foo enter foo
sl@0	2263	set result [trace info execution foo]
sl@0	2264	trace remove command foo delete foo
sl@0	2265	trace remove execution foo enter foo
sl@0	2266	rename foo {}
sl@0	2267	set result
sl@0	2268	} [list [list enter foo]]
sl@0	2269
sl@0	2270	test trace-32.1 {
sl@0	2271	TraceCommandInfo refcount decr in TraceCommandProc w/o loss of reference
sl@0	2272	} {
sl@0	2273	# Tcl Bug 811483
sl@0	2274	proc foo {} {}
sl@0	2275	trace add command foo delete foo
sl@0	2276	trace add execution foo enter foo
sl@0	2277	set result [trace info command foo]
sl@0	2278	rename foo {}
sl@0	2279	set result
sl@0	2280	} [list [list delete foo]]
sl@0	2281
sl@0	2282	test trace-33.1 {variable match with remove variable} {
sl@0	2283	unset -nocomplain x
sl@0	2284	trace variable x w foo
sl@0	2285	trace remove variable x write foo
sl@0	2286	llength [trace info variable x]
sl@0	2287	} 0
sl@0	2288
sl@0	2289	test trace-34.1 {Bug 1201035} {
sl@0	2290	set ::x [list]
sl@0	2291	proc foo {} {lappend ::x foo}
sl@0	2292	proc bar args {
sl@0	2293	lappend ::x $args
sl@0	2294	trace remove execution foo leavestep bar
sl@0	2295	trace remove execution foo enterstep bar
sl@0	2296	trace add execution foo leavestep bar
sl@0	2297	trace add execution foo enterstep bar
sl@0	2298	lappend ::x done
sl@0	2299	}
sl@0	2300	trace add execution foo leavestep bar
sl@0	2301	trace add execution foo enterstep bar
sl@0	2302	foo
sl@0	2303	set ::x
sl@0	2304	} {{{lappend ::x foo} enterstep} done foo}
sl@0	2305
sl@0	2306	test trace-34.2 {Bug 1224585} {
sl@0	2307	proc foo {} {}
sl@0	2308	proc bar args {trace remove execution foo leave soom}
sl@0	2309	trace add execution foo leave bar
sl@0	2310	trace add execution foo leave soom
sl@0	2311	foo
sl@0	2312	} {}
sl@0	2313
sl@0	2314	test trace-34.3 {Bug 1224585} {
sl@0	2315	proc foo {} {set x {}}
sl@0	2316	proc bar args {trace remove execution foo enterstep soom}
sl@0	2317	trace add execution foo enterstep soom
sl@0	2318	trace add execution foo enterstep bar
sl@0	2319	foo
sl@0	2320	} {}
sl@0	2321
sl@0	2322	# We test here for the half-documented and currently valid interplay between
sl@0	2323	# delete traces and namespace deletion.
sl@0	2324	test trace-34.4 {Bug 1047286} {
sl@0	2325	variable x notrace
sl@0	2326	proc callback {old - -} {
sl@0	2327	variable x "$old exists: [namespace which -command $old]"
sl@0	2328	}
sl@0	2329	namespace eval ::foo {proc bar {} {}}
sl@0	2330	trace add command ::foo::bar delete [namespace code callback]
sl@0	2331	namespace delete ::foo
sl@0	2332	set x
sl@0	2333	} {::foo::bar exists: ::foo::bar}
sl@0	2334
sl@0	2335	test trace-34.5 {Bug 1047286} {
sl@0	2336	variable x notrace
sl@0	2337	proc callback {old - -} {
sl@0	2338	variable x "$old exists: [namespace which -command $old]"
sl@0	2339	}
sl@0	2340	namespace eval ::foo {proc bar {} {}}
sl@0	2341	trace add command ::foo::bar delete [namespace code callback]
sl@0	2342	namespace eval ::foo namespace delete ::foo
sl@0	2343	set x
sl@0	2344	} {::foo::bar exists: }
sl@0	2345
sl@0	2346	test trace-34.6 {Bug 1458266} -setup {
sl@0	2347	proc dummy {} {}
sl@0	2348	proc stepTraceHandler {cmdString args} {
sl@0	2349	variable log
sl@0	2350	append log "[expr {[info level] - 1}]: [lindex [split $cmdString] 0]\n"
sl@0	2351	dummy
sl@0	2352	isTracedInside_2
sl@0	2353	}
sl@0	2354	proc cmdTraceHandler {cmdString args} {
sl@0	2355	# silent
sl@0	2356	}
sl@0	2357	proc isTracedInside_1 {} {
sl@0	2358	isTracedInside_2
sl@0	2359	}
sl@0	2360	proc isTracedInside_2 {} {
sl@0	2361	set x 2
sl@0	2362	}
sl@0	2363	} -body {
sl@0	2364	variable log {}
sl@0	2365	trace add execution isTracedInside_1 enterstep stepTraceHandler
sl@0	2366	trace add execution isTracedInside_2 enterstep stepTraceHandler
sl@0	2367	isTracedInside_1
sl@0	2368	variable first $log
sl@0	2369	set log {}
sl@0	2370	trace add execution dummy enter cmdTraceHandler
sl@0	2371	isTracedInside_1
sl@0	2372	variable second $log
sl@0	2373	expr {($first eq $second) ? "ok" : "\n$first\nand\n\n$second\ndiffer"}
sl@0	2374	} -cleanup {
sl@0	2375	unset -nocomplain log first second
sl@0	2376	rename dummy {}
sl@0	2377	rename stepTraceHandler {}
sl@0	2378	rename cmdTraceHandler {}
sl@0	2379	rename isTracedInside_1 {}
sl@0	2380	rename isTracedInside_2 {}
sl@0	2381	} -result ok
sl@0	2382
sl@0	2383	# Delete procedures when done, so we don't clash with other tests
sl@0	2384	# (e.g. foobar will clash with 'unknown' tests).
sl@0	2385	catch {rename foobar {}}
sl@0	2386	catch {rename foo {}}
sl@0	2387	catch {rename bar {}}
sl@0	2388
sl@0	2389	# Unset the varaible when done
sl@0	2390	catch {unset info}
sl@0	2391
sl@0	2392	# cleanup
sl@0	2393	::tcltest::cleanupTests
sl@0	2394	return

author	sl
	Tue, 10 Jun 2014 14:32:02 +0200
changeset 1	260cb5ec6c19
permissions	-rw-r--r--