debuggers: import openocd-0.7.0
Initial check-in of openocd-0.7.0 as it can be downloaded from http://sourceforge.net/projects/openocd/files/openocd/0.7.0/ Any modifications will follow. Change-Id: I6949beaefd589e046395ea0cb80f4e1ab1654d55
This commit is contained in:
454
debuggers/openocd/jimtcl/tests/timer.test
Normal file
454
debuggers/openocd/jimtcl/tests/timer.test
Normal file
@ -0,0 +1,454 @@
|
||||
# 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.
|
||||
# Copyright (c) 1998-1999 by Scriptics Corporation.
|
||||
#
|
||||
# See the file "license.terms" for information on usage and redistribution
|
||||
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
#
|
||||
# RCS: @(#) $Id: timer.test,v 1.7.2.1 2001/10/13 01:14:19 hobbs Exp $
|
||||
|
||||
source [file dirname [info script]]/testing.tcl
|
||||
needs cmd after eventloop
|
||||
|
||||
test timer-1.1 {Tcl_CreateTimerHandler procedure} {
|
||||
foreach i [after info] {
|
||||
after cancel $i
|
||||
}
|
||||
set x ""
|
||||
foreach i {20 40 200 10 30} {
|
||||
after $i lappend x $i
|
||||
}
|
||||
after 50
|
||||
update
|
||||
set x
|
||||
} {10 20 30 40}
|
||||
|
||||
test timer-2.1 {Tcl_DeleteTimerHandler procedure} {
|
||||
foreach i [after info] {
|
||||
after cancel $i
|
||||
}
|
||||
set x ""
|
||||
foreach i {20 40 60 10 30} {
|
||||
after $i lappend x $i
|
||||
}
|
||||
after cancel lappend x 60
|
||||
after cancel lappend x 10
|
||||
after 50
|
||||
update
|
||||
set x
|
||||
} {20 30 40}
|
||||
|
||||
# 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 20 { set x fired }
|
||||
update idletasks
|
||||
set result $x
|
||||
after 40
|
||||
update
|
||||
lappend result $x
|
||||
} {start fired}
|
||||
test timer-3.2 {TimerHandlerEventProc procedure: multiple timers} {
|
||||
foreach i [after info] {
|
||||
after cancel $i
|
||||
}
|
||||
foreach i {40 120 200} {
|
||||
after $i lappend x $i
|
||||
}
|
||||
after 50
|
||||
set result ""
|
||||
set x ""
|
||||
update
|
||||
lappend result $x
|
||||
after 80
|
||||
update
|
||||
lappend result $x
|
||||
after 80
|
||||
update
|
||||
lappend result $x
|
||||
} {40 {40 120} {40 120 200}}
|
||||
test timer-3.3 {TimerHandlerEventProc procedure: reentrant timer deletion} {
|
||||
foreach i [after info] {
|
||||
after cancel $i
|
||||
}
|
||||
set x {}
|
||||
after 20 lappend x 20
|
||||
set i [after 60 lappend x 60]
|
||||
after 40 after cancel $i
|
||||
after 80
|
||||
update
|
||||
set x
|
||||
} 20
|
||||
test timer-3.4 {TimerHandlerEventProc procedure: all expired timers fire} {
|
||||
foreach i [after info] {
|
||||
after cancel $i
|
||||
}
|
||||
set x {}
|
||||
after 20 lappend x a
|
||||
after 40 lappend x b
|
||||
after 60 lappend x c
|
||||
after 70
|
||||
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 20 {lappend x a; after 0 lappend x b}
|
||||
after 20
|
||||
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 20 {lappend x a; after 20 lappend x b; after 20}
|
||||
after 20
|
||||
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 ...?"}}
|
||||
test timer-6.2 {Tcl_AfterCmd procedure, basics} jim {
|
||||
list [catch {after 2x} msg] $msg
|
||||
} {1 {bad argument "2x": must be cancel, idle, or info}}
|
||||
test timer-6.3 {Tcl_AfterCmd procedure, basics} jim {
|
||||
list [catch {after gorp} msg] $msg
|
||||
} {1 {bad argument "gorp": must be cancel, idle, or info}}
|
||||
test timer-6.4 {Tcl_AfterCmd procedure, ms argument} {
|
||||
set x before
|
||||
after 80 {set x after}
|
||||
after 40
|
||||
update
|
||||
set y $x
|
||||
after 80
|
||||
update
|
||||
list $y $x
|
||||
} {before after}
|
||||
test timer-6.5 {Tcl_AfterCmd procedure, ms argument} {
|
||||
set x before
|
||||
after 60 {set x after}
|
||||
after 40
|
||||
update
|
||||
set y $x
|
||||
after 40
|
||||
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 20 set x after]
|
||||
after cancel $y
|
||||
after 40
|
||||
update
|
||||
set x
|
||||
} {before}
|
||||
test timer-6.10 {Tcl_AfterCmd procedure, cancel option} {
|
||||
foreach i [after info] {
|
||||
after cancel $i
|
||||
}
|
||||
set x before
|
||||
after 20 set x after
|
||||
after cancel set x after
|
||||
after 40
|
||||
update
|
||||
set x
|
||||
} {before}
|
||||
test timer-6.11 {Tcl_AfterCmd procedure, cancel option} {
|
||||
foreach i [after info] {
|
||||
after cancel $i
|
||||
}
|
||||
set x before
|
||||
after 20 set x after
|
||||
set id [after 60 set x after]
|
||||
after cancel $id
|
||||
after 40
|
||||
update
|
||||
set y $x
|
||||
set x cleared
|
||||
after 40
|
||||
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 20 {
|
||||
set x done
|
||||
after cancel $id
|
||||
}
|
||||
]
|
||||
vwait x
|
||||
} {}
|
||||
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}
|
||||
|
||||
test timer-6.23 {Tcl_AfterCmd procedure, no option, script with NULL} {
|
||||
foreach i [after info] {
|
||||
after cancel $i
|
||||
}
|
||||
set x "hello world"
|
||||
after 1 "set x ab\0cd"
|
||||
after 10
|
||||
update
|
||||
string length $x
|
||||
} {5}
|
||||
test timer-6.24 {Tcl_AfterCmd procedure, no option, script with NULL} {
|
||||
foreach i [after info] {
|
||||
after cancel $i
|
||||
}
|
||||
set x "hello world"
|
||||
after 1 set x ab\0cd
|
||||
after 10
|
||||
update
|
||||
string length $x
|
||||
} {5}
|
||||
test timer-6.25 {Tcl_AfterCmd procedure, cancel option, script with NULL} {
|
||||
foreach i [after info] {
|
||||
after cancel $i
|
||||
}
|
||||
set x "hello world"
|
||||
after 1 set x ab\0cd
|
||||
after cancel "set x ab\0ef"
|
||||
set x [llength [after info]]
|
||||
foreach i [after info] {
|
||||
after cancel $i
|
||||
}
|
||||
set x
|
||||
} {1}
|
||||
test timer-6.26 {Tcl_AfterCmd procedure, cancel option, script with NULL} {
|
||||
foreach i [after info] {
|
||||
after cancel $i
|
||||
}
|
||||
set x "hello world"
|
||||
after 1 set x ab\0cd
|
||||
after cancel set x ab\0ef
|
||||
set y [llength [after info]]
|
||||
foreach i [after info] {
|
||||
after cancel $i
|
||||
}
|
||||
set y
|
||||
} {1}
|
||||
test timer-6.27 {Tcl_AfterCmd procedure, idle option, script with NULL} {
|
||||
foreach i [after info] {
|
||||
after cancel $i
|
||||
}
|
||||
set x "hello world"
|
||||
after idle "set x ab\0cd"
|
||||
update
|
||||
string length $x
|
||||
} {5}
|
||||
test timer-6.28 {Tcl_AfterCmd procedure, idle option, script with NULL} {
|
||||
foreach i [after info] {
|
||||
after cancel $i
|
||||
}
|
||||
set x "hello world"
|
||||
after idle set x ab\0cd
|
||||
update
|
||||
string length $x
|
||||
} {5}
|
||||
test timer-6.29 {Tcl_AfterCmd procedure, info option, script with NULL} {
|
||||
foreach i [after info] {
|
||||
after cancel $i
|
||||
}
|
||||
set x "hello world"
|
||||
set id junk
|
||||
set id [after 10 set x ab\0cd]
|
||||
update
|
||||
set y [string length [lindex [lindex [after info $id] 0] 2]]
|
||||
foreach i [after info] {
|
||||
after cancel $i
|
||||
}
|
||||
set y
|
||||
} {5}
|
||||
|
||||
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 20 {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 {
|
||||
set ::x $msg
|
||||
}
|
||||
set x empty
|
||||
after 20 {error "After error"}
|
||||
after 200
|
||||
set y $x
|
||||
update
|
||||
catch {rename bgerror {}}
|
||||
list $y $x
|
||||
} {empty {After error}}
|
||||
|
||||
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
|
||||
}
|
||||
|
||||
testreport
|
||||
Reference in New Issue
Block a user