summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorsebres <sebres@users.sourceforge.net>2017-07-03 13:30:36 (GMT)
committersebres <sebres@users.sourceforge.net>2017-07-03 13:30:36 (GMT)
commit4378179cb1eb32da7bfaf8041c2a3efafdffff33 (patch)
tree2c1199a9526680899bc66ea3adf9a7093ebaec8f
parent76c0ca9d7fe8df2d4a5b46ead77bd8bd3f9d05a5 (diff)
downloadtcl-4378179cb1eb32da7bfaf8041c2a3efafdffff33.zip
tcl-4378179cb1eb32da7bfaf8041c2a3efafdffff33.tar.gz
tcl-4378179cb1eb32da7bfaf8041c2a3efafdffff33.tar.bz2
"after at" set factor to 1000000 (seconds), test cases fixed
-rw-r--r--generic/tclTimer.c10
-rw-r--r--tests/event.test12
-rw-r--r--tests/timer.test4
3 files changed, 13 insertions, 13 deletions
diff --git a/generic/tclTimer.c b/generic/tclTimer.c
index 5878b39..e6b0799 100644
--- a/generic/tclTimer.c
+++ b/generic/tclTimer.c
@@ -1468,10 +1468,10 @@ TclpGetUTimeFromObj(
if (tm < 0x7FFFFFFFFFFFFFFFL / factor) { /* avoid overflow */
/* use precise as possible calculation by double (microseconds) */
if (factor == 1) {
- *timePtr = tm;
+ *timePtr = (Tcl_WideInt)tm;
} else {
*timePtr = ((Tcl_WideInt)tm * factor) +
- (((long)(tm*factor)) % factor);
+ (((Tcl_WideInt)(tm*factor)) % factor);
}
return TCL_OK;
}
@@ -1553,7 +1553,7 @@ Tcl_AfterObjCmd(
) {
Tcl_AppendResult(interp, "bad argument \"",
Tcl_GetString(objv[1]),
- "\": must be at, cancel, idle, info, prolong or a time", NULL);
+ "\": must be at, cancel, idle, info or a time", NULL);
return TCL_ERROR;
}
@@ -1584,8 +1584,8 @@ Tcl_AfterObjCmd(
Tcl_WrongNumArgs(interp, 1, objv, "?option? time");
return TCL_ERROR;
}
- /* get time from object, default factor 1000 (ms) */
- if (TclpGetUTimeFromObj(interp, objv[1], &usec, 1000) != TCL_OK) {
+ /* get time from object, default factor for "at" - 1000000 (s) */
+ if (TclpGetUTimeFromObj(interp, objv[1], &usec, 1000000) != TCL_OK) {
return TCL_ERROR;
}
if (objc == 2) {
diff --git a/tests/event.test b/tests/event.test
index 9a31ff7..cb887c5 100644
--- a/tests/event.test
+++ b/tests/event.test
@@ -407,7 +407,7 @@ foo
test event-7.10 {after at - absolute time} {
set result {}
# 1st test simple delay (and mix generation / recursive processing)
- set attm [expr {[clock milliseconds]+150}]
+ set attm [expr {[clock milliseconds]/1000.0 + 0.150}]
after 0 {lappend result 1}
after 100 {
update; # this don't catch event 3
@@ -415,7 +415,7 @@ test event-7.10 {after at - absolute time} {
after at $attm; # delay to 150ms from start
update; # this still don't catch event 3 also
lappend result 2b
- after at [incr attm 100]; # delay to 250ms from start
+ after at [expr {$attm + 0.100}]; # delay to 250ms from start
update; # this should catch event 3
lappend result 2c
}
@@ -423,13 +423,13 @@ test event-7.10 {after at - absolute time} {
vwait a
# 2nd test events "at" (mix due-times between relative/absolute events)
lappend result --
- set sttm [clock milliseconds]
+ set sttm [expr {[clock milliseconds]/1000.0}]
after 200 {lappend result 4; set a done}
after 120 {lappend result 5}
after 40 {lappend result 6}
- after at [expr {$sttm+160}] {lappend result at-1}
- after at [expr {$sttm+80}] {lappend result at-2}
- after at ${sttm}.999 {lappend result at-3}
+ after at [expr {$sttm+0.160}] {lappend result at-1}
+ after at [expr {$sttm+0.080}] {lappend result at-2}
+ after at [expr {$sttm+0.005}] {lappend result at-3}
after 2000 {lappend result [set a timeout]}
after 0 {lappend result 7}
vwait a
diff --git a/tests/timer.test b/tests/timer.test
index 5a63d54..2dbcae3 100644
--- a/tests/timer.test
+++ b/tests/timer.test
@@ -175,10 +175,10 @@ test timer-6.1 {Tcl_AfterCmd procedure, basics} {
} {1 {wrong # args: should be "after option ?arg arg ...?"}}
test timer-6.2 {Tcl_AfterCmd procedure, basics} {
list [catch {after 2x} msg] $msg
-} {1 {bad argument "2x": must be cancel, idle, info, or an integer}}
+} {1 {bad argument "2x": must be at, cancel, idle, info or a time}}
test timer-6.3 {Tcl_AfterCmd procedure, basics} {
list [catch {after gorp} msg] $msg
-} {1 {bad argument "gorp": must be cancel, idle, info, or an integer}}
+} {1 {bad argument "gorp": must be at, cancel, idle, info or a time}}
test timer-6.4 {Tcl_AfterCmd procedure, ms argument} {
set x before
# cover prompt events also (immediate handling differs now):