From 4378179cb1eb32da7bfaf8041c2a3efafdffff33 Mon Sep 17 00:00:00 2001
From: sebres <sebres@users.sourceforge.net>
Date: Mon, 3 Jul 2017 13:30:36 +0000
Subject: "after at" set factor to 1000000 (seconds), test cases fixed

---
 generic/tclTimer.c | 10 +++++-----
 tests/event.test   | 12 ++++++------
 tests/timer.test   |  4 ++--
 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):
-- 
cgit v0.12