Made test cmdAH-24.2 more robust.

2 files changed, 21 insertions, 15 deletions

diff --git a/ChangeLog b/ChangeLog
index 5c0f30d..b96db80 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,9 @@
 2001-11-27  Donal K. Fellows  <fellowsd@cs.man.ac.uk>
 
+	* tests/cmdAH.test (cmdAH-24.2): Made test less sensitive to OS
+	preemption, but perfection isn't practical [Bug 463189, reported
+	by Don Porter.]
+
 	* tests/switch.test (switch-9.*): Added tests to exercise more of
 	the argument checking.  (switch-7.2,switch-7.3): Test changed
 	behaviour slightly.
diff --git a/tests/cmdAH.test b/tests/cmdAH.test
index 0ebbe48..afcc968 100644
--- a/tests/cmdAH.test
+++ b/tests/cmdAH.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: cmdAH.test,v 1.16 2001/11/23 01:25:51 das Exp $
+# RCS: @(#) $Id: cmdAH.test,v 1.17 2001/11/27 14:12:35 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -1288,14 +1288,29 @@ set file [makeFile "data" touch.me]
 test cmdAH-24.1 {Tcl_FileObjCmd: mtime} {
     list [catch {file mtime a b c} msg] $msg
 } {1 {wrong # args: should be "file mtime name ?time?"}}
+# Check (allowing for clock-skew and OS interrupts as best we can)
+# that the change in mtime on a file being written is the time elapsed
+# between writes.  Note that this can still fail on very busy systems
+# if there are long preemptions between the writes and the reading of
+# the clock, but there's not much you can do about that other than the
+# completely horrible "keep on trying to write until you managed to do
+# it all in less than a second."  - DKF
 test cmdAH-24.2 {Tcl_FileObjCmd: mtime} {
+    set f [open gorp.file w]
+    puts $f "More text"
+    set localOld [clock seconds]
+    close $f
     set old [file mtime gorp.file]
     after 2000
     set f [open gorp.file w]
     puts $f "More text"
+    set localNew [clock seconds]
     close $f
     set new [file mtime gorp.file]
-    expr {($new > $old) && ($new <= ($old+5))}
+    expr {
+	($new > $old) && ($localNew > $localOld) &&
+	(abs(($new-$old) - ($localNew-$localOld)) <= 1)
+    }
 } {1}
 test cmdAH-24.3 {Tcl_FileObjCmd: mtime} {
     catch {unset stat}
@@ -1618,16 +1633,3 @@ cd $cmdAHwd
 
 ::tcltest::cleanupTests
 return
-
-
-
-
-
-
-
-
-
-
-
-
-