diff options
| author | Steve Bennett <steveb@workware.net.au> | 2010-09-16 10:01:27 +1000 |
|---|---|---|
| committer | Steve Bennett <steveb@workware.net.au> | 2010-10-15 11:02:54 +1000 |
| commit | b4a77b8c3c18870009b5a2c193a1772552b5e4b5 (patch) | |
| tree | 10bc85e5e1a702f07547b6cd0ee8fc077d03cd99 /tests/testing.tcl | |
| parent | 1f3eccbfe50172710a1190bd1d13f03778d587a1 (diff) | |
| download | jimtcl-b4a77b8c3c18870009b5a2c193a1772552b5e4b5.zip jimtcl-b4a77b8c3c18870009b5a2c193a1772552b5e4b5.tar.gz jimtcl-b4a77b8c3c18870009b5a2c193a1772552b5e4b5.tar.bz2 | |
eventloop improvements and enhancements
Move Jim_EvalObjBackground() out of the core to eventloop
Time events are now kept and triggered in time order
Time handlers are removed before execution
Add 'update'
Add 'after info' and 'after idle'
Include time events in the return from Jim_ProcessEvents()
Add Tcl eventloop tests
Signed-off-by: Steve Bennett <steveb@workware.net.au>
Diffstat (limited to 'tests/testing.tcl')
| -rw-r--r-- | tests/testing.tcl | 15 |
1 files changed, 9 insertions, 6 deletions
diff --git a/tests/testing.tcl b/tests/testing.tcl index 9c0b4ec..5e6b395 100644 --- a/tests/testing.tcl +++ b/tests/testing.tcl @@ -4,8 +4,11 @@ proc makeFile {contents name} { close $f } -proc info_source {script} { - join [info source $script] : +proc error_source {} { + lassign [info stacktrace] p f l + if {$f ne ""} { + puts "At : $f:$l" + } } catch { @@ -14,8 +17,7 @@ catch { proc errorInfo {msg} { return $::errorInfo } - proc info_source {script} { - return "" + proc error_source {} { } } @@ -33,7 +35,8 @@ proc test {id descr script expected} { if {!$::testquiet} { puts -nonewline "$id " } - set rc [catch {uplevel 1 $script} result] + set rc [catch {uplevel 1 $script} result opts] + # Note that rc=2 is return if {($rc == 0 || $rc == 2) && $result eq $expected} { if {!$::testquiet} { @@ -45,7 +48,7 @@ proc test {id descr script expected} { puts -nonewline "$id " } puts "ERR $descr" - puts "At : [info_source $script]" + error_source puts "Expected: '$expected'" puts "Got : '$result'" incr ::testresults(numfail) |