URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tcl/] [tests/] [timer.test] - Blame information for rev 1765

Details | Compare with Previous | View Log


# This file contains a collection of tests for the procedures in the
# file tclTimer.c, which includes the "after" Tcl command.  Sourcing
# this file into Tcl runs the tests and generates output for errors.
# No output means no errors were found.
#
# 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) 1997 by Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: timer.test,v 1.1.1.1 2002-01-16 10:25:36 markom Exp $
 
if {[string compare test [info procs test]] == 1} then {source defs}
 
test timer-1.1 {Tcl_CreateTimerHandler procedure} {
    foreach i [after info] {
        after cancel $i
    }
    set x ""
    foreach i {100 200 1000 50 150} {
        after $i lappend x $i
    }
    after 200
    update
    set x
} {50 100 150 200}
 
test timer-2.1 {Tcl_DeleteTimerHandler procedure} {
    foreach i [after info] {
        after cancel $i
    }
    set x ""
    foreach i {100 200 300 50 150} {
        after $i lappend x $i
    }
    after cancel lappend x 150
    after cancel lappend x 50
    after 200
    update
    set x
} {100 200}
 
# No tests for Tcl_ServiceTimer or ResetTimer, since it is already tested
# above.
 
test timer-3.1 {TimerHandlerEventProc procedure: event masks} {
    set x start
    after 100 { set x fired }
    update idletasks
    set result $x
    after 200
    update
    lappend result $x
} {start fired}
test timer-3.2 {TimerHandlerEventProc procedure: multiple timers} {
    foreach i [after info] {
        after cancel $i
    }
    foreach i {200 600 1000} {
        after $i lappend x $i
    }
    after 200
    set result ""
    set x ""
    update
    lappend result $x
    after 400
    update
    lappend result $x
    after 400
    update
    lappend result $x
} {200 {200 600} {200 600 1000}}
test timer-3.3 {TimerHandlerEventProc procedure: reentrant timer deletion} {
    foreach i [after info] {
        after cancel $i
    }
    set x {}
    after 100 lappend x 100
    set i [after 300 lappend x 300]
    after 200 after cancel $i
    after 400
    update
    set x
} 100
test timer-3.4 {TimerHandlerEventProc procedure: all expired timers fire} {
    foreach i [after info] {
        after cancel $i
    }
    set x {}
    after 100 lappend x a
    after 200 lappend x b
    after 300 lappend x c
    after 300
    vwait x
    set x
} {a b c}
test timer-3.5 {TimerHandlerEventProc procedure: reentrantly added timers don't fire} {
    foreach i [after info] {
        after cancel $i
    }
    set x {}
    after 100 {lappend x a; after 0 lappend x b}
    after 100
    vwait x
    set x
} a
test timer-3.6 {TimerHandlerEventProc procedure: reentrantly added timers don't fire} {
    foreach i [after info] {
        after cancel $i
    }
    set x {}
    after 100 {lappend x a; after 100 lappend x b; after 100}
    after 100
    vwait x
    set result $x
    vwait x
    lappend result $x
} {a {a b}}
 
# No tests for Tcl_DoWhenIdle:  it's already tested by other tests
# below.
 
test timer-4.1 {Tcl_CancelIdleCall procedure} {
    foreach i [after info] {
        after cancel $i
    }
    set x before
    set y before
    set z before
    after idle set x after1
    after idle set y after2
    after idle set z after3
    after cancel set y after2
    update idletasks
    concat $x $y $z
} {after1 before after3}
test timer-4.2 {Tcl_CancelIdleCall procedure} {
    foreach i [after info] {
        after cancel $i
    }
    set x before
    set y before
    set z before
    after idle set x after1
    after idle set y after2
    after idle set z after3
    after cancel set x after1
    update idletasks
    concat $x $y $z
} {before after2 after3}
 
test timer-5.1 {Tcl_ServiceIdle, self-rescheduling handlers} {
    foreach i [after info] {
        after cancel $i
    }
    set x 1
    set y 23
    after idle {incr x; after idle {incr x; after idle {incr x}}}
    after idle {incr y}
    vwait x
    set result "$x $y"
    update idletasks
    lappend result $x
} {2 24 4}
 
test timer-6.1 {Tcl_AfterCmd procedure, basics} {
    list [catch {after} msg] $msg
} {1 {wrong # args: should be "after option ?arg arg ...?"}}
test timer-6.2 {Tcl_AfterCmd procedure, basics} {
    list [catch {after 2x} msg] $msg
} {1 {expected integer but got "2x"}}
test timer-6.3 {Tcl_AfterCmd procedure, basics} {
    list [catch {after gorp} msg] $msg
} {1 {bad argument "gorp": must be cancel, idle, info, or a number}}
test timer-6.4 {Tcl_AfterCmd procedure, ms argument} {
    set x before
    after 400 {set x after}
    after 200
    update
    set y $x
    after 400
    update
    list $y $x
} {before after}
test timer-6.5 {Tcl_AfterCmd procedure, ms argument} {
    set x before
    after 300 set x after
    after 200
    update
    set y $x
    after 200
    update
    list $y $x
} {before after}
test timer-6.6 {Tcl_AfterCmd procedure, cancel option} {
    list [catch {after cancel} msg] $msg
} {1 {wrong # args: should be "after cancel id|command"}}
test timer-6.7 {Tcl_AfterCmd procedure, cancel option} {
    after cancel after#1
} {}
test timer-6.8 {Tcl_AfterCmd procedure, cancel option} {
    after cancel {foo bar}
} {}
test timer-6.9 {Tcl_AfterCmd procedure, cancel option} {
    foreach i [after info] {
        after cancel $i
    }
    set x before
    set y [after 100 set x after]
    after cancel $y
    after 200
    update
    set x
} {before}
test timer-6.10 {Tcl_AfterCmd procedure, cancel option} {
    foreach i [after info] {
        after cancel $i
    }
    set x before
    after 100 set x after
    after cancel {set x after}
    after 200
    update
    set x
} {before}
test timer-6.11 {Tcl_AfterCmd procedure, cancel option} {
    foreach i [after info] {
        after cancel $i
    }
    set x before
    after 100 set x after
    set id [after 300 set x after]
    after cancel $id
    after 200
    update
    set y $x
    set x cleared
    after 200
    update
    list $y $x
} {after cleared}
test timer-6.12 {Tcl_AfterCmd procedure, cancel option} {
    foreach i [after info] {
        after cancel $i
    }
    set x first
    after idle lappend x second
    after idle lappend x third
    set i [after idle lappend x fourth]
    after cancel {lappend x second}
    after cancel $i
    update idletasks
    set x
} {first third}
test timer-6.13 {Tcl_AfterCmd procedure, cancel option, multiple arguments for command} {
    foreach i [after info] {
        after cancel $i
    }
    set x first
    after idle lappend x second
    after idle lappend x third
    set i [after idle lappend x fourth]
    after cancel lappend x second
    after cancel $i
    update idletasks
    set x
} {first third}
test timer-6.14 {Tcl_AfterCmd procedure, cancel option, cancel during handler, used to dump core} {
    foreach i [after info] {
        after cancel $i
    }
    set id [
        after 100 {
            set x done
            after cancel $id
        }
    ]
    vwait x
} {}
test timer-6.15 {Tcl_AfterCmd procedure, cancel option, multiple interps} {
    foreach i [after info] {
        after cancel $i
    }
    interp create x
    x eval {set a before; set b before; after idle {set a a-after};
            after idle {set b b-after}}
    set result [llength [x eval after info]]
    lappend result [llength [after info]]
    after cancel {set b b-after}
    set a aaa
    set b bbb
    x eval {after cancel set a a-after}
    update idletasks
    lappend result $a $b [x eval {list $a $b}]
    interp delete x
    set result
} {2 0 aaa bbb {before b-after}}
test timer-6.16 {Tcl_AfterCmd procedure, idle option} {
    list [catch {after idle} msg] $msg
} {1 {wrong # args: should be "after idle script script ..."}}
test timer-6.17 {Tcl_AfterCmd procedure, idle option} {
    set x before
    after idle {set x after}
    set y $x
    update idletasks
    list $y $x
} {before after}
test timer-6.18 {Tcl_AfterCmd procedure, idle option} {
    set x before
    after idle set x after
    set y $x
    update idletasks
    list $y $x
} {before after}
set event1 [after idle event 1]
set event2 [after 1000 event 2]
interp create x
set childEvent [x eval {after idle event in child}]
test timer-6.19 {Tcl_AfterCmd, info option} {
    lsort [after info]
} [lsort "$event1 $event2"]
test timer-6.20 {Tcl_AfterCmd, info option} {
    list [catch {after info a b} msg] $msg
} {1 {wrong # args: should be "after info ?id?"}}
test timer-6.21 {Tcl_AfterCmd, info option} {
    list [catch {after info $childEvent} msg] $msg
} "1 {event \"$childEvent\" doesn't exist}"
test timer-6.22 {Tcl_AfterCmd, info option} {
    list [after info $event1] [after info $event2]
} {{{event 1} idle} {{event 2} timer}}
after cancel $event1
after cancel $event2
interp delete x
 
set event [after idle foo bar]
scan $event after#%d id
test timer-7.1 {GetAfterEvent procedure} {
    list [catch {after info xfter#$id} msg] $msg
} "1 {event \"xfter#$id\" doesn't exist}"
test timer-7.2 {GetAfterEvent procedure} {
    list [catch {after info afterx$id} msg] $msg
} "1 {event \"afterx$id\" doesn't exist}"
test timer-7.3 {GetAfterEvent procedure} {
    list [catch {after info after#ab} msg] $msg
} {1 {event "after#ab" doesn't exist}}
test timer-7.4 {GetAfterEvent procedure} {
    list [catch {after info after#} msg] $msg
} {1 {event "after#" doesn't exist}}
test timer-7.5 {GetAfterEvent procedure} {
    list [catch {after info after#${id}x} msg] $msg
} "1 {event \"after#${id}x\" doesn't exist}"
test timer-7.6 {GetAfterEvent procedure} {
    list [catch {after info afterx[expr $id+1]} msg] $msg
} "1 {event \"afterx[expr $id+1]\" doesn't exist}"
after cancel $event
 
test timer-8.1 {AfterProc procedure} {
    set x before
    proc foo {} {
        set x untouched
        after 100 {set x after}
        after 200
        update
        return $x
    }
    list [foo] $x
} {untouched after}
test timer-8.2 {AfterProc procedure} {
    catch {rename bgerror {}}
    proc bgerror msg {
        global x errorInfo
        set x [list $msg $errorInfo]
    }
    set x empty
    after 100 {error "After error"}
    after 200
    set y $x
    update
    catch {rename bgerror {}}
    list $y $x
} {empty {{After error} {After error
    while executing
"error "After error""
    ("after" script)}}}
test timer-8.3 {AfterProc procedure, deleting handler from itself} {
    foreach i [after info] {
        after cancel $i
    }
    proc foo {} {
        global x
        set x {}
        foreach i [after info] {
            lappend x [after info $i]
        }
        after cancel foo
    }
    after idle foo
    after 1000 {error "I shouldn't ever have executed"}
    update idletasks
    set x
} {{{error "I shouldn't ever have executed"} timer}}
test timer-8.4 {AfterProc procedure, deleting handler from itself} {
    foreach i [after info] {
        after cancel $i
    }
    proc foo {} {
        global x
        set x {}
        foreach i [after info] {
            lappend x [after info $i]
        }
        after cancel foo
    }
    after 1000 {error "I shouldn't ever have executed"}
    after idle foo
    update idletasks
    set x
} {{{error "I shouldn't ever have executed"} timer}}
 
foreach i [after info] {
    after cancel $i
}
 
# No test for FreeAfterPtr, since it is already tested above.
 
 
test timer-9.1 {AfterCleanupProc procedure} {
    catch {interp delete x}
    interp create x
    x eval {after 200 {
        lappend x after
        puts "part 1: this message should not appear"
    }}
    after 200 {lappend x after2}
    x eval {after 200 {
        lappend x after3
        puts "part 2: this message should not appear"
    }}
    after 200 {lappend x after4}
    x eval {after 200 {
        lappend x after5
        puts "part 3: this message should not appear"
    }}
    interp delete x
    set x before
    after 300
    update
    set x
} {before after2 after4}
 

Browse

Tools

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tcl/] [tests/] [timer.test] - Blame information for rev 1765

Line No.	Rev	Author	Line
1	578	markom	`# This file contains a collection of tests for the procedures in the`
2			`# file tclTimer.c, which includes the "after" Tcl command. Sourcing`
3			`# this file into Tcl runs the tests and generates output for errors.`
4			`# No output means no errors were found.`
5			`#`
6			`# This file contains a collection of tests for one or more of the Tcl`
7			`# built-in commands. Sourcing this file into Tcl runs the tests and`
8			`# generates output for errors. No output means no errors were found.`
9			`#`
10			`# Copyright (c) 1997 by Sun Microsystems, Inc.`
11			`#`
12			`# See the file "license.terms" for information on usage and redistribution`
13			`# of this file, and for a DISCLAIMER OF ALL WARRANTIES.`
14			`#`
15			`# RCS: @(#) $Id: timer.test,v 1.1.1.1 2002-01-16 10:25:36 markom Exp $`
16
17			`if {[string compare test [info procs test]] == 1} then {source defs}`
18
19			`test timer-1.1 {Tcl_CreateTimerHandler procedure} {`
20			`foreach i [after info] {`
21			`after cancel $i`
22			`}`
23			`set x ""`
24			`foreach i {100 200 1000 50 150} {`
25			`after $i lappend x $i`
26			`}`
27			`after 200`
28			`update`
29			`set x`
30			`} {50 100 150 200}`
31
32			`test timer-2.1 {Tcl_DeleteTimerHandler procedure} {`
33			`foreach i [after info] {`
34			`after cancel $i`
35			`}`
36			`set x ""`
37			`foreach i {100 200 300 50 150} {`
38			`after $i lappend x $i`
39			`}`
40			`after cancel lappend x 150`
41			`after cancel lappend x 50`
42			`after 200`
43			`update`
44			`set x`
45			`} {100 200}`
46
47			`# No tests for Tcl_ServiceTimer or ResetTimer, since it is already tested`
48			`# above.`
49
50			`test timer-3.1 {TimerHandlerEventProc procedure: event masks} {`
51			`set x start`
52			`after 100 { set x fired }`
53			`update idletasks`
54			`set result $x`
55			`after 200`
56			`update`
57			`lappend result $x`
58			`} {start fired}`
59			`test timer-3.2 {TimerHandlerEventProc procedure: multiple timers} {`
60			`foreach i [after info] {`
61			`after cancel $i`
62			`}`
63			`foreach i {200 600 1000} {`
64			`after $i lappend x $i`
65			`}`
66			`after 200`
67			`set result ""`
68			`set x ""`
69			`update`
70			`lappend result $x`
71			`after 400`
72			`update`
73			`lappend result $x`
74			`after 400`
75			`update`
76			`lappend result $x`
77			`} {200 {200 600} {200 600 1000}}`
78			`test timer-3.3 {TimerHandlerEventProc procedure: reentrant timer deletion} {`
79			`foreach i [after info] {`
80			`after cancel $i`
81			`}`
82			`set x {}`
83			`after 100 lappend x 100`
84			`set i [after 300 lappend x 300]`
85			`after 200 after cancel $i`
86			`after 400`
87			`update`
88			`set x`
89			`} 100`
90			`test timer-3.4 {TimerHandlerEventProc procedure: all expired timers fire} {`
91			`foreach i [after info] {`
92			`after cancel $i`
93			`}`
94			`set x {}`
95			`after 100 lappend x a`
96			`after 200 lappend x b`
97			`after 300 lappend x c`
98			`after 300`
99			`vwait x`
100			`set x`
101			`} {a b c}`
102			`test timer-3.5 {TimerHandlerEventProc procedure: reentrantly added timers don't fire} {`
103			`foreach i [after info] {`
104			`after cancel $i`
105			`}`
106			`set x {}`
107			`after 100 {lappend x a; after 0 lappend x b}`
108			`after 100`
109			`vwait x`
110			`set x`
111			`} a`
112			`test timer-3.6 {TimerHandlerEventProc procedure: reentrantly added timers don't fire} {`
113			`foreach i [after info] {`
114			`after cancel $i`
115			`}`
116			`set x {}`
117			`after 100 {lappend x a; after 100 lappend x b; after 100}`
118			`after 100`
119			`vwait x`
120			`set result $x`
121			`vwait x`
122			`lappend result $x`
123			`} {a {a b}}`
124
125			`# No tests for Tcl_DoWhenIdle: it's already tested by other tests`
126			`# below.`
127
128			`test timer-4.1 {Tcl_CancelIdleCall procedure} {`
129			`foreach i [after info] {`
130			`after cancel $i`
131			`}`
132			`set x before`
133			`set y before`
134			`set z before`
135			`after idle set x after1`
136			`after idle set y after2`
137			`after idle set z after3`
138			`after cancel set y after2`
139			`update idletasks`
140			`concat $x $y $z`
141			`} {after1 before after3}`
142			`test timer-4.2 {Tcl_CancelIdleCall procedure} {`
143			`foreach i [after info] {`
144			`after cancel $i`
145			`}`
146			`set x before`
147			`set y before`
148			`set z before`
149			`after idle set x after1`
150			`after idle set y after2`
151			`after idle set z after3`
152			`after cancel set x after1`
153			`update idletasks`
154			`concat $x $y $z`
155			`} {before after2 after3}`
156
157			`test timer-5.1 {Tcl_ServiceIdle, self-rescheduling handlers} {`
158			`foreach i [after info] {`
159			`after cancel $i`
160			`}`
161			`set x 1`
162			`set y 23`
163			`after idle {incr x; after idle {incr x; after idle {incr x}}}`
164			`after idle {incr y}`
165			`vwait x`
166			`set result "$x $y"`
167			`update idletasks`
168			`lappend result $x`
169			`} {2 24 4}`
170
171			`test timer-6.1 {Tcl_AfterCmd procedure, basics} {`
172			`list [catch {after} msg] $msg`
173			`} {1 {wrong # args: should be "after option ?arg arg ...?"}}`
174			`test timer-6.2 {Tcl_AfterCmd procedure, basics} {`
175			`list [catch {after 2x} msg] $msg`
176			`} {1 {expected integer but got "2x"}}`
177			`test timer-6.3 {Tcl_AfterCmd procedure, basics} {`
178			`list [catch {after gorp} msg] $msg`
179			`} {1 {bad argument "gorp": must be cancel, idle, info, or a number}}`
180			`test timer-6.4 {Tcl_AfterCmd procedure, ms argument} {`
181			`set x before`
182			`after 400 {set x after}`
183			`after 200`
184			`update`
185			`set y $x`
186			`after 400`
187			`update`
188			`list $y $x`
189			`} {before after}`
190			`test timer-6.5 {Tcl_AfterCmd procedure, ms argument} {`
191			`set x before`
192			`after 300 set x after`
193			`after 200`
194			`update`
195			`set y $x`
196			`after 200`
197			`update`
198			`list $y $x`
199			`} {before after}`
200			`test timer-6.6 {Tcl_AfterCmd procedure, cancel option} {`
201			`list [catch {after cancel} msg] $msg`
202			`} {1 {wrong # args: should be "after cancel id\|command"}}`
203			`test timer-6.7 {Tcl_AfterCmd procedure, cancel option} {`
204			`after cancel after#1`
205			`} {}`
206			`test timer-6.8 {Tcl_AfterCmd procedure, cancel option} {`
207			`after cancel {foo bar}`
208			`} {}`
209			`test timer-6.9 {Tcl_AfterCmd procedure, cancel option} {`
210			`foreach i [after info] {`
211			`after cancel $i`
212			`}`
213			`set x before`
214			`set y [after 100 set x after]`
215			`after cancel $y`
216			`after 200`
217			`update`
218			`set x`
219			`} {before}`
220			`test timer-6.10 {Tcl_AfterCmd procedure, cancel option} {`
221			`foreach i [after info] {`
222			`after cancel $i`
223			`}`
224			`set x before`
225			`after 100 set x after`
226			`after cancel {set x after}`
227			`after 200`
228			`update`
229			`set x`
230			`} {before}`
231			`test timer-6.11 {Tcl_AfterCmd procedure, cancel option} {`
232			`foreach i [after info] {`
233			`after cancel $i`
234			`}`
235			`set x before`
236			`after 100 set x after`
237			`set id [after 300 set x after]`
238			`after cancel $id`
239			`after 200`
240			`update`
241			`set y $x`
242			`set x cleared`
243			`after 200`
244			`update`
245			`list $y $x`
246			`} {after cleared}`
247			`test timer-6.12 {Tcl_AfterCmd procedure, cancel option} {`
248			`foreach i [after info] {`
249			`after cancel $i`
250			`}`
251			`set x first`
252			`after idle lappend x second`
253			`after idle lappend x third`
254			`set i [after idle lappend x fourth]`
255			`after cancel {lappend x second}`
256			`after cancel $i`
257			`update idletasks`
258			`set x`
259			`} {first third}`
260			`test timer-6.13 {Tcl_AfterCmd procedure, cancel option, multiple arguments for command} {`
261			`foreach i [after info] {`
262			`after cancel $i`
263			`}`
264			`set x first`
265			`after idle lappend x second`
266			`after idle lappend x third`
267			`set i [after idle lappend x fourth]`
268			`after cancel lappend x second`
269			`after cancel $i`
270			`update idletasks`
271			`set x`
272			`} {first third}`
273			`test timer-6.14 {Tcl_AfterCmd procedure, cancel option, cancel during handler, used to dump core} {`
274			`foreach i [after info] {`
275			`after cancel $i`
276			`}`
277			`set id [`
278			`after 100 {`
279			`set x done`
280			`after cancel $id`
281			`}`
282			`]`
283			`vwait x`
284			`} {}`
285			`test timer-6.15 {Tcl_AfterCmd procedure, cancel option, multiple interps} {`
286			`foreach i [after info] {`
287			`after cancel $i`
288			`}`
289			`interp create x`
290			`x eval {set a before; set b before; after idle {set a a-after};`
291			`after idle {set b b-after}}`
292			`set result [llength [x eval after info]]`
293			`lappend result [llength [after info]]`
294			`after cancel {set b b-after}`
295			`set a aaa`
296			`set b bbb`
297			`x eval {after cancel set a a-after}`
298			`update idletasks`
299			`lappend result $a $b [x eval {list $a $b}]`
300			`interp delete x`
301			`set result`
302			`} {2 0 aaa bbb {before b-after}}`
303			`test timer-6.16 {Tcl_AfterCmd procedure, idle option} {`
304			`list [catch {after idle} msg] $msg`
305			`} {1 {wrong # args: should be "after idle script script ..."}}`
306			`test timer-6.17 {Tcl_AfterCmd procedure, idle option} {`
307			`set x before`
308			`after idle {set x after}`
309			`set y $x`
310			`update idletasks`
311			`list $y $x`
312			`} {before after}`
313			`test timer-6.18 {Tcl_AfterCmd procedure, idle option} {`
314			`set x before`
315			`after idle set x after`
316			`set y $x`
317			`update idletasks`
318			`list $y $x`
319			`} {before after}`
320			`set event1 [after idle event 1]`
321			`set event2 [after 1000 event 2]`
322			`interp create x`
323			`set childEvent [x eval {after idle event in child}]`
324			`test timer-6.19 {Tcl_AfterCmd, info option} {`
325			`lsort [after info]`
326			`} [lsort "$event1 $event2"]`
327			`test timer-6.20 {Tcl_AfterCmd, info option} {`
328			`list [catch {after info a b} msg] $msg`
329			`} {1 {wrong # args: should be "after info ?id?"}}`
330			`test timer-6.21 {Tcl_AfterCmd, info option} {`
331			`list [catch {after info $childEvent} msg] $msg`
332			`} "1 {event \"$childEvent\" doesn't exist}"`
333			`test timer-6.22 {Tcl_AfterCmd, info option} {`
334			`list [after info $event1] [after info $event2]`
335			`} {{{event 1} idle} {{event 2} timer}}`
336			`after cancel $event1`
337			`after cancel $event2`
338			`interp delete x`
339
340			`set event [after idle foo bar]`
341			`scan $event after#%d id`
342			`test timer-7.1 {GetAfterEvent procedure} {`
343			`list [catch {after info xfter#$id} msg] $msg`
344			`} "1 {event \"xfter#$id\" doesn't exist}"`
345			`test timer-7.2 {GetAfterEvent procedure} {`
346			`list [catch {after info afterx$id} msg] $msg`
347			`} "1 {event \"afterx$id\" doesn't exist}"`
348			`test timer-7.3 {GetAfterEvent procedure} {`
349			`list [catch {after info after#ab} msg] $msg`
350			`} {1 {event "after#ab" doesn't exist}}`
351			`test timer-7.4 {GetAfterEvent procedure} {`
352			`list [catch {after info after#} msg] $msg`
353			`} {1 {event "after#" doesn't exist}}`
354			`test timer-7.5 {GetAfterEvent procedure} {`
355			`list [catch {after info after#${id}x} msg] $msg`
356			`} "1 {event \"after#${id}x\" doesn't exist}"`
357			`test timer-7.6 {GetAfterEvent procedure} {`
358			`list [catch {after info afterx[expr $id+1]} msg] $msg`
359			`} "1 {event \"afterx[expr $id+1]\" doesn't exist}"`
360			`after cancel $event`
361
362			`test timer-8.1 {AfterProc procedure} {`
363			`set x before`
364			`proc foo {} {`
365			`set x untouched`
366			`after 100 {set x after}`
367			`after 200`
368			`update`
369			`return $x`
370			`}`
371			`list [foo] $x`
372			`} {untouched after}`
373			`test timer-8.2 {AfterProc procedure} {`
374			`catch {rename bgerror {}}`
375			`proc bgerror msg {`
376			`global x errorInfo`
377			`set x [list $msg $errorInfo]`
378			`}`
379			`set x empty`
380			`after 100 {error "After error"}`
381			`after 200`
382			`set y $x`
383			`update`
384			`catch {rename bgerror {}}`
385			`list $y $x`
386			`} {empty {{After error} {After error`
387			`while executing`
388			`"error "After error""`
389			`("after" script)}}}`
390			`test timer-8.3 {AfterProc procedure, deleting handler from itself} {`
391			`foreach i [after info] {`
392			`after cancel $i`
393			`}`
394			`proc foo {} {`
395			`global x`
396			`set x {}`
397			`foreach i [after info] {`
398			`lappend x [after info $i]`
399			`}`
400			`after cancel foo`
401			`}`
402			`after idle foo`
403			`after 1000 {error "I shouldn't ever have executed"}`
404			`update idletasks`
405			`set x`
406			`} {{{error "I shouldn't ever have executed"} timer}}`
407			`test timer-8.4 {AfterProc procedure, deleting handler from itself} {`
408			`foreach i [after info] {`
409			`after cancel $i`
410			`}`
411			`proc foo {} {`
412			`global x`
413			`set x {}`
414			`foreach i [after info] {`
415			`lappend x [after info $i]`
416			`}`
417			`after cancel foo`
418			`}`
419			`after 1000 {error "I shouldn't ever have executed"}`
420			`after idle foo`
421			`update idletasks`
422			`set x`
423			`} {{{error "I shouldn't ever have executed"} timer}}`
424
425			`foreach i [after info] {`
426			`after cancel $i`
427			`}`
428
429			`# No test for FreeAfterPtr, since it is already tested above.`
430
431
432			`test timer-9.1 {AfterCleanupProc procedure} {`
433			`catch {interp delete x}`
434			`interp create x`
435			`x eval {after 200 {`
436			`lappend x after`
437			`puts "part 1: this message should not appear"`
438			`}}`
439			`after 200 {lappend x after2}`
440			`x eval {after 200 {`
441			`lappend x after3`
442			`puts "part 2: this message should not appear"`
443			`}}`
444			`after 200 {lappend x after4}`
445			`x eval {after 200 {`
446			`lappend x after5`
447			`puts "part 3: this message should not appear"`
448			`}}`
449			`interp delete x`
450			`set x before`
451			`after 300`
452			`update`
453			`set x`
454			`} {before after2 after4}`
455