From 0660514c8f0c2acc9b501b3dacf25ec326479e52 Mon Sep 17 00:00:00 2001 From: dkf Date: Fri, 4 Jul 2003 13:04:12 +0000 Subject: * tests/cmdAH.test: Made tests of [file mtime] work better on FAT filesystems. [Patch 760768] Also a little general cleanup. --- ChangeLog | 3 ++ tests/cmdAH.test | 105 ++++++++++++++++++++++++++++++++++++++++--------------- 2 files changed, 79 insertions(+), 29 deletions(-) diff --git a/ChangeLog b/ChangeLog index ae498ed..05f4779 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,8 @@ 2003-07-04 Donal K. Fellows + * tests/cmdAH.test: Made tests of [file mtime] work better on FAT + filesystems. [Patch 760768] Also a little general cleanup. + * generic/tclCmdMZ.c (Tcl_StringObjCmd): Made [string map] accept dictionaries for maps. This is much trickier than it looks, since map entry ordering is significant. [Bug 759936] diff --git a/tests/cmdAH.test b/tests/cmdAH.test index f276939..2c142ae 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.33 2003/05/12 22:51:46 dkf Exp $ +# RCS: @(#) $Id: cmdAH.test,v 1.34 2003/07/04 13:04:12 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2.1 @@ -22,7 +22,7 @@ tcltest::testConstraint testchmod \ tcltest::testConstraint testsetplatform \ [string equal testsetplatform [info commands testsetplatform]] tcltest::testConstraint testvolumetype \ - [string equal testvolumetype [info commands testvoluemtype]] + [string equal testvolumetype [info commands testvolumetype]] tcltest::testConstraint linkDirectory [expr \ {$tcl_platform(platform) ne "windows" || \ ([string index $tcl_platform(osVersion) 0] >= 5 \ @@ -195,7 +195,7 @@ test cmdAH-5.4 {Tcl_FileObjCmd} { #volume test cmdAH-6.1 {Tcl_FileObjCmd: volumes} { - list [catch {file volumes x} msg] $msg + list [catch {file volumes x} msg] $msg } {1 {wrong # args: should be "file volumes"}} test cmdAH-6.2 {Tcl_FileObjCmd: volumes} { set volumeList [file volumes] @@ -203,13 +203,13 @@ test cmdAH-6.2 {Tcl_FileObjCmd: volumes} { set result 0 } else { set result 1 - } + } } {1} test cmdAH-6.3 {Tcl_FileObjCmd: volumes} {macOrUnix} { set volumeList [file volumes] catch [list glob -nocomplain [lindex $volumeList 0]*] } {0} -test cmdAH-6.4 {Tcl_FileObjCmd: volumes} {pcOnly} { +test cmdAH-6.4 {Tcl_FileObjCmd: volumes} winOnly { set volumeList [string tolower [file volumes]] list [catch {lsearch $volumeList "c:/"} element] [expr $element != -1] [catch {list glob -nocomplain [lindex $volumeList $element]*}] } {0 1 0} @@ -1082,8 +1082,8 @@ test cmdAH-18.2 {Tcl_FileObjCmd: executable} {testchmod} { } 0 test cmdAH-18.3 {Tcl_FileObjCmd: executable} {unixOnly testchmod} { # Only on unix will setting the execute bit on a regular file - # cause that file to be executable. - + # cause that file to be executable. + testchmod 0775 $gorpfile file exe $gorpfile } 1 @@ -1091,13 +1091,13 @@ test cmdAH-18.3 {Tcl_FileObjCmd: executable} {unixOnly testchmod} { test cmdAH-18.4 {Tcl_FileObjCmd: executable} {macOnly testchmod} { # On mac, the only executable files are of type APPL. - set x [file exe $gorpfile] + set x [file exe $gorpfile] file attrib $gorpfile -type APPL lappend x [file exe $gorpfile] } {0 1} -test cmdAH-18.5 {Tcl_FileObjCmd: executable} {pcOnly testchmod} { +test cmdAH-18.5 {Tcl_FileObjCmd: executable} {winOnly testchmod} { # On pc, must be a .exe, .com, etc. - + set x [file exe $gorpfile] set gorpexe [makeFile foo gorp.exe] lappend x [file exe $gorpexe] @@ -1106,7 +1106,7 @@ test cmdAH-18.5 {Tcl_FileObjCmd: executable} {pcOnly testchmod} { } {0 1} test cmdAH-18.6 {Tcl_FileObjCmd: executable} {testchmod} { # Directories are always executable. - + file exe $dirfile } 1 @@ -1211,7 +1211,7 @@ test cmdAH-20.5 {Tcl_FileObjCmd: atime touch} {unixOnly} { set modatime [file atime $file $newatime] expr {$newatime == $modatime ? 1 : "$newatime != $modatime"} } 1 -test cmdAH-20.6 {Tcl_FileObjCmd: atime touch} {pcOnly testvolumetype} { +test cmdAH-20.6 {Tcl_FileObjCmd: atime touch} {winOnly testvolumetype} { set old [pwd] cd $::tcltest::temporaryDirectory if {![string equal "NTFS" [testvolumetype]]} { @@ -1315,8 +1315,27 @@ test cmdAH-23.10 {Tcl_FileObjCmd: mkdir} { set res } {1 1} -# mtime - +# mtime + +proc waitForEvenSecondForFAT {} { + # Windows 9x uses filesystems (the FAT* family of FSes) without + # enough data in its timestamps for even per-second-accurate + # timings. :^( + # This procedure based on work by Helmut Giese + + global tcl_platform + if {$tcl_platform(platform) ne "windows"} {return} + if {[lindex [file system [temporaryDirectory]] 1] == "NTFS"} {return} + # Assume non-NTFS means FAT{12,16,32} and hence in need of special help + set start [clock seconds] + while {1} { + set now [clock seconds] + if {$now!=$start && !($now & 1)} { + return + } + after 50 + } +} set file [makeFile "data" touch.me] test cmdAH-24.1 {Tcl_FileObjCmd: mtime} { @@ -1330,20 +1349,22 @@ test cmdAH-24.1 {Tcl_FileObjCmd: mtime} { # 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} { + waitForEvenSecondForFAT set f [open $gorpfile w] puts $f "More text" - set localOld [clock seconds] close $f - set old [file mtime $gorpfile] + set clockOld [clock seconds] + set fileOld [file mtime $gorpfile] after 2000 set f [open $gorpfile w] puts $f "More text" - set localNew [clock seconds] close $f - set new [file mtime $gorpfile] + set clockNew [clock seconds] + set fileNew [file mtime $gorpfile] expr { - ($new > $old) && ($localNew > $localOld) && - (abs(($new-$old) - ($localNew-$localOld)) <= 1) + (($fileNew > $fileOld) && ($clockNew > $clockOld) && + (abs(($fileNew-$fileOld) - ($clockNew-$clockOld)) <= 1)) ? "1" : + "file:($fileOld=>$fileNew) clock:($clockOld=>$clockNew)" } } {1} test cmdAH-24.3 {Tcl_FileObjCmd: mtime} { @@ -1366,7 +1387,7 @@ test cmdAH-24.5 {Tcl_FileObjCmd: mtime} { set name [file join [temporaryDirectory] tf] } - # Make sure that a new file's time is correct. 10 seconds variance + # Make sure that a new file's time is correct. 10 seconds variance # is allowed used due to slow networks or clock skew on a network drive. file delete -force $name @@ -1378,14 +1399,14 @@ test cmdAH-24.5 {Tcl_FileObjCmd: mtime} { test cmdAH-24.7 {Tcl_FileObjCmd: mtime} { list [catch {file mtime $file notint} msg] $msg } {1 {expected integer but got "notint"}} -test cmdAH-24.8 {Tcl_FileObjCmd: mtime touch} { +test cmdAH-24.8 {Tcl_FileObjCmd: mtime touch} macOrUnix { set mtime [file mtime $file] after 1100; # pause a sec to notice change in mtime set newmtime [clock seconds] set modmtime [file mtime $file $newmtime] expr {$newmtime == $modmtime ? 1 : "$newmtime != $modmtime"} } 1 -test cmdAH-24.9 {Tcl_FileObjCmd: mtime touch with non-ascii chars} { +test cmdAH-24.9 {Tcl_FileObjCmd: mtime touch with non-ascii chars} macOrUnix { set oldfile $file # introduce some non-ascii characters. append file \u2022 @@ -1401,7 +1422,33 @@ test cmdAH-24.9 {Tcl_FileObjCmd: mtime touch with non-ascii chars} { } expr {$newmtime == $modmtime ? 1 : "$newmtime != $modmtime"} } 1 +test cmdAH-24.10 {Tcl_FileObjCmd: mtime touch} winOnly { + waitForEvenSecondForFAT + set mtime [file mtime $file] + after 2100; # pause two secs to notice change in mtime on FAT fs'es + set newmtime [clock seconds] + set modmtime [file mtime $file $newmtime] + expr {$newmtime == $modmtime ? 1 : "$newmtime != $modmtime"} +} 1 +test cmdAH-24.11 {Tcl_FileObjCmd: mtime touch with non-ascii chars} winOnly { + waitForEvenSecondForFAT + set oldfile $file + # introduce some non-ascii characters. + append file \u2022 + file delete -force $file + file rename $oldfile $file + set mtime [file mtime $file] + after 2100; # pause two secs to notice change in mtime on FAT fs'es + set newmtime [clock seconds] + set err [catch {file mtime $file $newmtime} modmtime] + file rename $file $oldfile + if {$err} { + error $modmtime + } + expr {$newmtime == $modmtime ? 1 : "$newmtime != $modmtime"} +} 1 removeFile touch.me +rename waitForEvenSecondForFAT {} # owned @@ -1431,7 +1478,7 @@ test cmdAH-26.4 {Tcl_FileObjCmd: readlink errors} {macOnly nonPortable} { list [catch {file readlink _bogus_} msg] [string tolower $msg] \ [string tolower $errorCode] } {1 {could not readlink "_bogus_": no such file or directory} {posix enoent {no such file or directory}}} -test cmdAH-26.5 {Tcl_FileObjCmd: readlink errors} {pcOnly nonPortable} { +test cmdAH-26.5 {Tcl_FileObjCmd: readlink errors} {winOnly nonPortable} { list [catch {file readlink _bogus_} msg] [string tolower $msg] \ [string tolower $errorCode] } {1 {could not readlink "_bogus_": invalid argument} {posix einval {invalid argument}}} @@ -1500,14 +1547,14 @@ test cmdAH-28.8 {Tcl_FileObjCmd: stat} { removeFile $filename set x } 1 -test cmdAH-28.9 {Tcl_FileObjCmd: stat} {pcOnly} { +test cmdAH-28.9 {Tcl_FileObjCmd: stat} winOnly { # stat of root directory was failing. # don't care about answer, just that test runs. # relative paths that resolve to root set old [pwd] cd c:/ - file stat c: stat + file stat c: stat file stat c:. stat file stat . stat cd $old @@ -1516,15 +1563,15 @@ test cmdAH-28.9 {Tcl_FileObjCmd: stat} {pcOnly} { file stat c:/ stat file stat c:/. stat } {} -test cmdAH-28.10 {Tcl_FileObjCmd: stat} {pcOnly nonPortable} { +test cmdAH-28.10 {Tcl_FileObjCmd: stat} {winOnly nonPortable} { # stat of root directory was failing. # don't care about answer, just that test runs. file stat //pop/$env(USERNAME) stat file stat //pop/$env(USERNAME)/ stat file stat //pop/$env(USERNAME)/. stat -} {} -test cmdAH-28.11 {Tcl_FileObjCmd: stat} {pcOnly nonPortable} { +} {} +test cmdAH-28.11 {Tcl_FileObjCmd: stat} {winOnly nonPortable} { # stat of network directory was returning id of current local drive. set old [pwd] -- cgit v0.12