after at: added simple workaround for absolute timers/sleep ("after at real-time"): because we use monotonic time in all wait functions, so to avoid too long wait by the absolute timers (to be able to trigger it) if time jumped to the expected absolute time, just let block for maximal 1 second if absolute timers available.

test-cases: time-jumps (TIP #302) test covered now.
Note: on some platforms it is only possible if the user has corresponding privileges to change system date and time.
Ex.:  sudo LD_LIBRARY_PATH=. ./tclsh ../tests/timer.test -match timer-20.*

2 files changed, 200 insertions, 3 deletions

diff --git a/generic/tclTimer.c b/generic/tclTimer.c
index 074b61d..d22d326 100644
--- a/generic/tclTimer.c
+++ b/generic/tclTimer.c
@@ -943,9 +943,24 @@ TimerSetupProc(
 	#endif
 
 	if (timeOffs > 0) {
-	    blockTime.sec = (long) (timeOffs / 1000000);
-	    blockTime.usec = (unsigned long) (timeOffs % 1000000);
-
+	    blockTime.sec = 0;
+	    if (timeOffs >= 1000000) {
+		/*
+		 * Note we use monotonic time by all wait functions, so to
+		 * avoid too long wait by the absolute timers (to be able
+		 * to trigger it) if time jumped to the expected time, just
+		 * let block for maximal 1s if absolute timers available.
+		 */
+		if (tsdPtr->absTimerList) {
+		    /* we've some absolute timers - won't wait longer as 1s. */
+		    timeOffs = 1000000;
+		}
+		blockTime.sec = (long) (timeOffs / 1000000);
+		blockTime.usec = (unsigned long)(timeOffs % 1000000);
+	    } else {
+		blockTime.sec = 0;
+		blockTime.usec = (unsigned long)timeOffs;
+	    }
 	} else {
 	    blockTime.sec = 0;
 	    blockTime.usec = 0;
@@ -1792,6 +1807,14 @@ AfterDelay(
 	    }
 	}
 	diff = endTime - now;
+	if (absolute && diff >= 1000000) {
+	    /*
+	     * Note by absolute sleep we should avoid too long waits, to be
+	     * able to process further if time jumped to the expected time, so
+	     * just let wait maximal 1 second.
+	     */
+	    diff = 1000000;
+	}
 	if (iPtr->limit.timeEvent == NULL || diff < limOffs) {
 	    if (diff > 0) {
 		TclpUSleep(diff);
diff --git a/tests/timer.test b/tests/timer.test
index 2dbcae3..0b20d71 100644
--- a/tests/timer.test
+++ b/tests/timer.test
@@ -581,6 +581,180 @@ test timer-11.3 {[after] correct timer ordering (insert ahead)} \
     } \
     -result {ev:0 ev:0.1 ev:0.25 ev:0.5 ev:0.75 ev:1}
 
+# -----------------------------------------------------------------------------
+# 
+# timer-20.x --
+# 
+#    Following test-cases cover event-driven functionality during time-jump's
+#
+#    Note: on some platforms it is only possible if the user has corresponding
+#          privileges to change system date and time.
+#
+# Ex.:  sudo LD_LIBRARY_PATH=. ./tclsh ../tests/timer.test -match timer-20.*
+# -----------------------------------------------------------------------------
+
+proc timejump {args} {
+  set tnow [clock clicks]
+  set tm [clock format [clock add [clock seconds] {*}$args] -format %H:%M:%S]
+  #puts -nonewline "***[format \[%04X\] [pid]]*** jump to $tm ($args) "
+  if {$::tcl_platform(platform) eq "windows"} {
+    exec $::env(COMSPEC) /c time $tm
+  } else {
+    exec date +%T -s $tm
+  }
+  #puts "***[format \[%04X\] [pid]]*** [clock format [clock seconds] -format {%Y-%m-%d %H:%M:%S}] =="
+}
+
+testConstraint ChangeTimePrivilege [expr {![catch { timejump 0 minutes }]}]
+testConstraint NewVWaitAfter	   [expr {![catch { vwait 0 nothing }]}]
+
+# provide monotonic command, if "clock monotonic" not available (old core):
+if {![catch {::tcl::clock::monotonic}]} {
+  namespace inscope ::tcl::clock {namespace export monotonic}
+  namespace import ::tcl::clock::monotonic
+} else {
+  proc monotonic {} {
+    variable tickFactor
+    # warming-up:
+    clock clicks; clock microseconds
+    # calc tick2usec factor:
+    set tick [::tcl::clock::clicks]; set usec [::tcl::clock::microseconds]
+    after 100
+    set tickFactor [expr {double([::tcl::clock::clicks] - $tick) / ([::tcl::clock::microseconds] - $usec)}]
+    proc monotonic {} {
+      variable tickFactor
+      expr {wide([::tcl::clock::clicks] / $tickFactor)} 
+    }
+    monotonic
+  }
+}
+# asynchronous function doing 3 time jumps (+1 min, +1 min, -2 minutes) in 250-ms:
+proc delayedtimejump {delay {async 1} {startms {}}} {
+  # async code (executed in separate process):
+  if {$async} {
+    set code ""
+    foreach pr {timejump delayedtimejump} {
+	append code [list proc $pr [info args $pr] [info body $pr]] \n
+    }
+    append code "delayedtimejump $delay 0 [::tcl::clock::milliseconds]"
+    exec [info nameofexecutable] << $code &
+    return
+  }
+  # time-jumps (1st in 250-ms, 2nd and 3rd in given delay):
+  set delay1 250
+  if {$startms ne {}} {
+     set delay1 [expr {250 - ([::tcl::clock::milliseconds] - $startms)}]
+     if {$delay1 < 0} { set delay1 0 }
+  }
+  after $delay1; timejump +1 minutes
+  after $delay; timejump +1 minutes
+  after $delay; timejump -2 minutes
+}
+
+proc test-timer-with-jump {code maxCount expMT {maxOffs 100}} {
+    set mitm [set sttm [clock seconds]]
+    set stmt [monotonic]
+    set expMT [expr {$expMT * 1000}]
+    set maxOffs [expr {$maxOffs * 1000}]
+    set res {}
+    set jumped 0
+    for {set i 0} {$i < $maxCount} {incr i} {
+	set rt [::tcl::clock::microseconds]
+	set mt [monotonic]
+	# execute:
+	if 1 $code
+	# verify monotonic time:
+	set mt [expr {[monotonic] - $mt}]
+	set rt [expr {[::tcl::clock::microseconds] - $rt}]
+	# give +/- 100-ms for some slow or busy systems:
+	if {$mt < $expMT - $maxOffs || $mt > $expMT + $maxOffs} {
+	  lappend res "$i. too large discrepancy mt: $mt ~ $expMT (rt: $rt)"
+	} else {
+	  #lappend res "$i. debug, # mt: $mt, rt: $rt"
+	}
+	# be sure we are in the future and then comming back:
+	if {$jumped > 2} break; # we are already back
+	if {[clock seconds] - $mitm > 30 || [clock seconds] - $mitm < -30} {
+	   set mitm [clock seconds]
+	   incr jumped
+	}
+    }
+    # wait for time-jump back (from the future):
+    set future [clock add $sttm +30 seconds]
+    set aftto [after 10000 {set tout 1}]
+    while {[clock seconds] >= $future} {
+	if {[vwait 100 tout]} {
+	   error "unexpected case: too long wait for time-reset."
+	}
+    }
+    after cancel $aftto
+    after 10
+    # result:
+    if {[llength $res]} {
+      return [join $res \n]
+    }
+    return $jumped
+}
+
+test timer-20.1 {time jump: after relative} {ChangeTimePrivilege} {
+    delayedtimejump 250; # delayed time jump in 250-ms
+    test-timer-with-jump {
+	after 150 {set x 1}; vwait x
+    } 20 150
+} 3
+
+test timer-20.2 {time jump: vwait timeout} {ChangeTimePrivilege NewVWaitAfter} {
+    delayedtimejump 250; # delayed time jump in 250-ms
+    test-timer-with-jump {
+	vwait -timer 150 nothing; # we want listen timer only
+    } 20 150
+} 3
+
+test timer-20.3 {time jump: simple sleep} {ChangeTimePrivilege} {
+    delayedtimejump 250; # delayed time jump in 250-ms
+    test-timer-with-jump {
+	after 150
+    } 20 150
+} 3
+
+
+# Increase delay between time-jumps (1.5s) for possible retarded reaction of 
+# the notifier by absolute timers (retarded recognition of the time-jump so
+# the time can jump again (also backwards) without recognition.
+# Note also we cannot test absolute timers by the backwards time-jump.
+
+test timer-20.4 {time jump: after absolute time - "after at real-time code"} {ChangeTimePrivilege NewVWaitAfter} {
+    set sttm [clock seconds]
+    set i 0
+    foreach tm [list \
+      [clock add $sttm +1 minute -2 second] \
+      [clock add $sttm +2 minute -2 second] \
+    ] {
+      after at $tm [list set x$i 1]
+      incr i
+    }
+    delayedtimejump 1500; # delayed time jump in 1.5s
+    test-timer-with-jump {
+    	# we want listen timer only:
+	if {![vwait -timer 10000 x$i]} {
+	   error "too long wait for \"x$i\" (should be maximal 1 second)"
+	}
+    } 2 250 3000; # max 3 seconds difference (compared to 1 minute)
+} 2
+
+test timer-20.5 {time jump: sleep to absolute time - "after at real-time"} {ChangeTimePrivilege NewVWaitAfter} {
+    set sttm [clock seconds]
+    set offsLst [list \
+      [clock add $sttm +1 minute] \
+      [clock add $sttm +2 minute] \
+    ]
+    delayedtimejump 1500; # delayed time jump in 1.5s
+    test-timer-with-jump {
+	upvar offsLst offsLst
+	after at [lindex $offsLst $i]
+    } 2 250 3000; # max 3 seconds difference (compared to 1 minute)
+} 2
+
 # cleanup
 ::tcltest::cleanupTests
 return