diff options
Diffstat (limited to 'tests/fileSystem.test')
| -rw-r--r-- | tests/fileSystem.test | 989 |
1 files changed, 572 insertions, 417 deletions
diff --git a/tests/fileSystem.test b/tests/fileSystem.test index 4c90376..c255b1e 100644 --- a/tests/fileSystem.test +++ b/tests/fileSystem.test @@ -1,13 +1,13 @@ # This file tests the filesystem and vfs internals. # -# This file contains a collection of tests for one or more of the Tcl built-in -# commands. Sourcing this file into Tcl runs the tests and generates output -# for errors. No output means no errors were found. +# This file contains a collection of tests for one or more of the Tcl +# built-in commands. Sourcing this file into Tcl runs the tests and +# generates output for errors. No output means no errors were found. # # Copyright (c) 2002 Vincent Darley. # -# See the file "license.terms" for information on usage and redistribution of -# this file, and for a DISCLAIMER OF ALL WARRANTIES. +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. package require tcltest 2 namespace eval ::tcl::test::fileSystem { @@ -19,17 +19,6 @@ namespace eval ::tcl::test::fileSystem { file delete -force [file join dir.dir linkinside.file] } -testConstraint loaddll 0 -catch { - ::tcltest::loadTestedCommands - package require -exact Tcltest [info patchlevel] - set ::ddever [package require dde] - set ::ddelib [lindex [package ifneeded dde $::ddever] 1] - set ::regver [package require registry] - set ::reglib [lindex [package ifneeded registry $::regver] 1] - testConstraint loaddll 1 -} - # Test for commands defined in Tcltest executable testConstraint testfilesystem [llength [info commands ::testfilesystem]] testConstraint testsetplatform [llength [info commands ::testsetplatform]] @@ -42,39 +31,44 @@ makeDirectory [file join dir.dir dirinside.dir] makeFile "test file in directory" [file join dir.dir inside.file] testConstraint unusedDrive 0 -testConstraint moreThanOneDrive 0 -apply {{} { - # The variables 'drive' and 'drives' will be used below. - variable drive {} drives {} - if {[testConstraint win]} { - set vols [string map [list :/ {}] [file volumes]] - for {set i 0} {$i < 26} {incr i} { - set drive [format %c [expr {$i + 65}]] - if {$drive ni $vols} { - testConstraint unusedDrive 1 - break - } +set drive {} +if {[testConstraint win]} { + set vols [string map [list :/ {}] [file volumes]] + for {set i 0} {$i < 26} {incr i} { + set drive [format %c [expr {$i + 65}]] + if {[lsearch -exact $vols $drive] == -1} { + testConstraint unusedDrive 1 + break } + } + unset i vols + # The variable 'drive' will be used below +} - set dir [pwd] - try { - foreach vol [file volumes] { - if {![catch {cd $vol}]} { - lappend drives $vol - } - } - testConstraint moreThanOneDrive [llength $drives] - } finally { - cd $dir - } +testConstraint moreThanOneDrive 0 +set drives [list] +if {[testConstraint win]} { + set dir [pwd] + foreach vol [file volumes] { + if {![catch {cd $vol}]} { + lappend drives $vol + } + } + if {[llength $drives] > 1} { + testConstraint moreThanOneDrive 1 } -} ::tcl::test::fileSystem} + # The variable 'drives' will be used below + unset vol + cd $dir + unset dir +} proc testPathEqual {one two} { if {$one eq $two} { - return "ok" + return 1 + } else { + return "not equal: $one $two" } - return "not equal: $one $two" } testConstraint hasLinks [expr {![catch { @@ -94,8 +88,6 @@ testConstraint hasLinks [expr {![catch { if {[testConstraint testsetplatform]} { set platform [testgetplatform] } - -# ---------------------------------------------------------------------- test filesystem-1.0 {link normalisation} {hasLinks} { string equal [file normalize gorp.file] [file normalize link.file] @@ -106,38 +98,37 @@ test filesystem-1.1 {link normalisation} {hasLinks} { test filesystem-1.2 {link normalisation} {hasLinks unix} { testPathEqual [file normalize [file join gorp.file foo]] \ [file normalize [file join link.file foo]] -} ok +} {1} test filesystem-1.3 {link normalisation} {hasLinks} { testPathEqual [file normalize [file join dir.dir foo]] \ [file normalize [file join dir.link foo]] -} ok +} {1} test filesystem-1.4 {link normalisation} {hasLinks} { testPathEqual [file normalize [file join dir.dir inside.file]] \ [file normalize [file join dir.link inside.file]] -} ok +} {1} test filesystem-1.5 {link normalisation} {hasLinks} { testPathEqual [file normalize [file join dir.dir linkinside.file]] \ [file normalize [file join dir.dir linkinside.file]] -} ok +} {1} test filesystem-1.6 {link normalisation} {hasLinks} { - string equal [file normalize [file join dir.dir linkinside.file]] \ - [file normalize [file join dir.link inside.file]] + string equal [file normalize [file join dir.dir linkinside.file]] \ + [file normalize [file join dir.link inside.file]] } {0} test filesystem-1.7 {link normalisation} {hasLinks unix} { testPathEqual [file normalize [file join dir.link linkinside.file foo]] \ [file normalize [file join dir.dir inside.file foo]] -} ok +} {1} test filesystem-1.8 {link normalisation} {hasLinks} { - string equal [file normalize [file join dir.dir linkinside.filefoo]] \ - [file normalize [file join dir.link inside.filefoo]] + string equal [file normalize [file join dir.dir linkinside.filefoo]] \ + [file normalize [file join dir.link inside.filefoo]] } {0} -test filesystem-1.9 {link normalisation} -setup { +test filesystem-1.9 {link normalisation} {unix hasLinks} { file delete -force dir.link -} -constraints {unix hasLinks} -body { file link dir.link [file nativename dir.dir] testPathEqual [file normalize [file join dir.dir linkinside.file foo]] \ [file normalize [file join dir.link inside.file foo]] -} -result ok +} {1} test filesystem-1.10 {link normalisation: double link} -constraints { unix hasLinks } -body { @@ -146,14 +137,14 @@ test filesystem-1.10 {link normalisation: double link} -constraints { [file normalize [file join dir2.link inside.file foo]] } -cleanup { file delete dir2.link -} -result ok +} -result {1} makeDirectory dir2.file test filesystem-1.11 {link normalisation: double link, back in tree} {unix hasLinks} { file link dir2.link dir.link file link [file join dir2.file dir2.link] [file join .. dir2.link] testPathEqual [file normalize [file join dir.dir linkinside.file foo]] \ [file normalize [file join dir2.file dir2.link inside.file foo]] -} ok +} {1} test filesystem-1.12 {file new native path} {} { for {set i 0} {$i < 10} {incr i} { foreach f [lsort [glob -nocomplain -type l *]] { @@ -210,49 +201,62 @@ test filesystem-1.25 {file normalisation} {win unusedDrive} { test filesystem-1.25.1 {file normalisation} {win unusedDrive} { file normalize ${drive}:/./.././..\\..\\a\\bb } "${drive}:/a/bb" -test filesystem-1.26 {link normalisation: link and ..} -setup { +test filesystem-1.26 {link normalisation: link and ..} {hasLinks} { file delete -force dir2.link -} -constraints {hasLinks} -body { set dir [file join dir2 foo bar] file mkdir $dir file link dir2.link [file join dir2 foo bar] - testPathEqual [file normalize [file join dir2 foo x]] \ - [file normalize [file join dir2.link .. x]] -} -result ok + set res [list [file normalize [file join dir2 foo x]] \ + [file normalize [file join dir2.link .. x]]] + if {![string equal [lindex $res 0] [lindex $res 1]]} { + set res "$res not equal" + } else { + set res "ok" + } +} {ok} test filesystem-1.27 {file normalisation: up and down with ..} { set dir [file join dir2 foo bar] file mkdir $dir set dir2 [file join dir2 .. dir2 foo .. foo bar] - list [testPathEqual [file normalize $dir] [file normalize $dir2]] \ - [file exists $dir] [file exists $dir2] -} {ok 1 1} -test filesystem-1.28 {link normalisation: link with .. and ..} -setup { + set res [list [file normalize $dir] [file normalize $dir2]] + set res2 [list [file exists $dir] [file exists $dir2]] + if {![string equal [lindex $res 0] [lindex $res 1]]} { + set res "exists: $res2, $res not equal" + } else { + set res "ok: $res2" + } +} {ok: 1 1} +test filesystem-1.28 {link normalisation: link with .. and ..} {hasLinks} { file delete -force dir2.link -} -constraints {hasLinks} -body { set dir [file join dir2 foo bar] file mkdir $dir set to [file join dir2 .. dir2 foo .. foo bar] file link dir2.link $to - testPathEqual [file normalize [file join dir2 foo x]] \ - [file normalize [file join dir2.link .. x]] -} -result ok -test filesystem-1.29 {link normalisation: link with ..} -setup { + set res [list [file normalize [file join dir2 foo x]] \ + [file normalize [file join dir2.link .. x]]] + if {![string equal [lindex $res 0] [lindex $res 1]]} { + set res "$res not equal" + } else { + set res "ok" + } +} {ok} +test filesystem-1.29 {link normalisation: link with ..} {hasLinks} { file delete -force dir2.link -} -constraints {hasLinks} -body { set dir [file join dir2 foo bar] file mkdir $dir set to [file join dir2 .. dir2 foo .. foo bar] file link dir2.link $to set res [file normalize [file join dir2.link x yyy z]] - if {[string match *..* $res]} { - return "$res must not contain '..'" + if {[string first ".." $res] != -1} { + set res "$res must not contain '..'" + } else { + set res "ok" } - return "ok" -} -result {ok} +} {ok} test filesystem-1.29.1 {link normalisation with two consecutive links} {hasLinks} { testPathEqual [file normalize [file join dir.link dirinside.link abc]] \ [file normalize [file join dir.dir dirinside.dir abc]] -} ok +} {1} file delete -force dir2.file file delete -force dir2.link file delete -force link.file dir.link @@ -261,9 +265,9 @@ file delete -force [file join dir.dir dirinside.link] removeFile [file join dir.dir inside.file] removeDirectory [file join dir.dir dirinside.dir] removeDirectory dir.dir -test filesystem-1.30 {normalisation of nonexistent user} -body { - file normalize ~noonewiththisname -} -returnCodes error -result {user "noonewiththisname" doesn't exist} +test filesystem-1.30 {normalisation of nonexistent user} { + list [catch {file normalize ~noonewiththisname} err] $err +} {1 {user "noonewiththisname" doesn't exist}} test filesystem-1.31 {link normalisation: link near filesystem root} {testsetplatform} { testsetplatform unix file normalize /foo/../bar @@ -276,8 +280,8 @@ test filesystem-1.33 {link normalisation: link near filesystem root} {testsetpla testsetplatform windows set res [file normalize C:/../bar] if {[testConstraint unix]} { - # Some unices go further in normalizing this -- not really a problem - # since this is a Windows test. + # Some unices go further in normalizing this -- not really + # a problem since this is a Windows test regexp {C:/bar$} $res res } set res @@ -285,106 +289,223 @@ test filesystem-1.33 {link normalisation: link near filesystem root} {testsetpla if {[testConstraint testsetplatform]} { testsetplatform $platform } -test filesystem-1.34 {file normalisation with '/./'} -body { - file normalize /foo/bar/anc/./.tml -} -match regexp -result {^(?:(?!/\./).)*$} -test filesystem-1.35a {file normalisation with '/./'} -body { - file normalize /ffo/bar/anc/./foo/.tml -} -match regexp -result {^(?:(?!/\./).)*$} -test filesystem-1.35b {file normalisation with '/./'} { - llength [regexp -all foo [file normalize /ffo/bar/anc/./foo/.tml]] -} 1 -test filesystem-1.36a {file normalisation with '/./'} -body { - file normalize /foo/bar/anc/././asdasd/.tml -} -match regexp -result {^(?:(?!/\./).)*$} -test filesystem-1.36b {file normalisation with '/./'} { - llength [regexp -all asdasd [file normalize /foo/bar/anc/././asdasd/.tml]] -} 1 -test filesystem-1.37 {file normalisation with '/./'} -body { +test filesystem-1.34 {file normalisation with '/./'} { + set res [file normalize /foo/bar/anc/./.tml] + if {[string first "/./" $res] != -1} { + set res "normalization of /foo/bar/anc/./.tml is: $res" + } else { + set res "ok" + } + set res +} {ok} +test filesystem-1.35 {file normalisation with '/./'} { + set res [file normalize /ffo/bar/anc/./foo/.tml] + if {[string first "/./" $res] != -1 || ([regsub -all "foo" $res "" reg] == 2)} { + set res "normalization of /ffo/bar/anc/./foo/.tml is: $res" + } else { + set res "ok" + } + set res +} {ok} +test filesystem-1.36 {file normalisation with '/./'} { + set res [file normalize /foo/bar/anc/././asdasd/.tml] + if {[string first "/./" $res] != -1 || ([regsub -all "asdasd" $res "" reg] == 2) } { + set res "normalization of /foo/bar/anc/././asdasd/.tml is: $res" + } else { + set res "ok" + } + set res +} {ok} +test filesystem-1.37 {file normalisation with '/./'} { set fname "/abc/./def/./ghi/./asda/.././.././asd/x/../../../../....." - file norm $fname -} -match regexp -result {^(?:[^/]|/(?:[^/]|$))+$} -test filesystem-1.38 {file normalisation with volume relative} -setup { - set dir [pwd] -} -constraints {win moreThanOneDrive} -body { + set res [file norm $fname] + if {[string first "//" $res] != -1} { + set res "normalization of $fname is: $res" + } else { + set res "ok" + } + set res +} {ok} +test filesystem-1.38 {file normalisation with volume relative} \ + {win moreThanOneDrive} { set path "[string range [lindex $drives 0] 0 1]foo" + set dir [pwd] cd [lindex $drives 1] - file norm $path -} -cleanup { + set res [file norm $path] cd $dir -} -result "[lindex $drives 0]foo" -test filesystem-1.39 {file normalisation with volume relative} -setup { - set old [pwd] -} -constraints {win} -body { + set res +} "[lindex $drives 0]foo" +test filesystem-1.39 {file normalisation with volume relative} {win} { set drv C:/ - cd [lindex [glob -type d -dir $drv *] 0] - file norm [string range $drv 0 1] -} -cleanup { + set dir [lindex [glob -type d -dir $drv *] 0] + set old [pwd] + cd $dir + set res [file norm [string range $drv 0 1]] cd $old -} -match regexp -result {.*[^/]} + if {[string index $res end] eq "/"} { + set res "Bad normalized path: $res" + } else { + set res "ok" + } +} {ok} test filesystem-1.40 {file normalisation with repeated separators} { - testPathEqual [file norm foo////bar] [file norm foo/bar] -} ok + set a [file norm foo////bar] + set b [file norm foo/bar] + + if {![string equal $a $b]} { + set res "Paths should be equal: $a , $b" + } else { + set res "ok" + } +} {ok} test filesystem-1.41 {file normalisation with repeated separators} {win} { - testPathEqual [file norm foo\\\\\\bar] [file norm foo/bar] -} ok + set a [file norm foo\\\\\\bar] + set b [file norm foo/bar] + + if {![string equal $a $b]} { + set res "Paths should be equal: $a , $b" + } else { + set res "ok" + } +} {ok} test filesystem-1.42 {file normalisation .. beyond root (Bug 1379287)} { - testPathEqual [file norm /xxx/..] [file norm /] -} ok + set a [file norm /xxx/..] + set b [file norm /] + + if {![string equal $a $b]} { + set res "Paths should be equal: $a , $b" + } else { + set res "ok" + } +} {ok} test filesystem-1.42.1 {file normalisation .. beyond root (Bug 1379287)} { - testPathEqual [file norm /xxx/../] [file norm /] -} ok + set a [file norm /xxx/../] + set b [file norm /] + + if {![string equal $a $b]} { + set res "Paths should be equal: $a , $b" + } else { + set res "ok" + } +} {ok} test filesystem-1.43 {file normalisation .. beyond root (Bug 1379287)} { - testPathEqual [file norm /xxx/foo/../..] [file norm /] -} ok + set a [file norm /xxx/foo/../..] + set b [file norm /] + + if {![string equal $a $b]} { + set res "Paths should be equal: $a , $b" + } else { + set res "ok" + } +} {ok} test filesystem-1.43.1 {file normalisation .. beyond root (Bug 1379287)} { - testPathEqual [file norm /xxx/foo/../../] [file norm /] -} ok + set a [file norm /xxx/foo/../../] + set b [file norm /] + + if {![string equal $a $b]} { + set res "Paths should be equal: $a , $b" + } else { + set res "ok" + } +} {ok} test filesystem-1.44 {file normalisation .. beyond root (Bug 1379287)} { - testPathEqual [file norm /xxx/foo/../../bar] [file norm /bar] -} ok + set a [file norm /xxx/foo/../../bar] + set b [file norm /bar] + + if {![string equal $a $b]} { + set res "Paths should be equal: $a , $b" + } else { + set res "ok" + } +} {ok} test filesystem-1.45 {file normalisation .. beyond root (Bug 1379287)} { - testPathEqual [file norm /xxx/../../bar] [file norm /bar] -} ok + set a [file norm /xxx/../../bar] + set b [file norm /bar] + + if {![string equal $a $b]} { + set res "Paths should be equal: $a , $b" + } else { + set res "ok" + } +} {ok} test filesystem-1.46 {file normalisation .. beyond root (Bug 1379287)} { - testPathEqual [file norm /xxx/../bar] [file norm /bar] -} ok + set a [file norm /xxx/../bar] + set b [file norm /bar] + + if {![string equal $a $b]} { + set res "Paths should be equal: $a , $b" + } else { + set res "ok" + } +} {ok} test filesystem-1.47 {file normalisation .. beyond root (Bug 1379287)} { - testPathEqual [file norm /..] [file norm /] -} ok + set a [file norm /..] + set b [file norm /] + + if {![string equal $a $b]} { + set res "Paths should be equal: $a , $b" + } else { + set res "ok" + } +} {ok} test filesystem-1.48 {file normalisation .. beyond root (Bug 1379287)} { - testPathEqual [file norm /../] [file norm /] -} ok + set a [file norm /../] + set b [file norm /] + + if {![string equal $a $b]} { + set res "Paths should be equal: $a , $b" + } else { + set res "ok" + } +} {ok} test filesystem-1.49 {file normalisation .. beyond root (Bug 1379287)} { - testPathEqual [file norm /.] [file norm /] -} ok + set a [file norm /.] + set b [file norm /] + + if {![string equal $a $b]} { + set res "Paths should be equal: $a , $b" + } else { + set res "ok" + } +} {ok} test filesystem-1.50 {file normalisation .. beyond root (Bug 1379287)} { - testPathEqual [file norm /./] [file norm /] -} ok + set a [file norm /./] + set b [file norm /] + + if {![string equal $a $b]} { + set res "Paths should be equal: $a , $b" + } else { + set res "ok" + } +} {ok} test filesystem-1.51 {file normalisation .. beyond root (Bug 1379287)} { - testPathEqual [file norm /../..] [file norm /] -} ok + set a [file norm /../..] + set b [file norm /] + + if {![string equal $a $b]} { + set res "Paths should be equal: $a , $b" + } else { + set res "ok" + } +} {ok} test filesystem-1.51.1 {file normalisation .. beyond root (Bug 1379287)} { - testPathEqual [file norm /../../] [file norm /] -} ok -test filesystem-1.52 {bug f9f390d0fa: file join where strep is not canonical} -constraints unix -body { - set x //foo - file normalize $x - file join $x bar -} -result /foo/bar -test filesystem-1.52.1 {bug f9f390d0fa: file join where strep is not canonical} -body { - set x //foo - file normalize $x - file join $x -} -result /foo + set a [file norm /../../] + set b [file norm /] + + if {![string equal $a $b]} { + set res "Paths should be equal: $a , $b" + } else { + set res "ok" + } +} {ok} test filesystem-2.0 {new native path} {unix} { foreach f [lsort [glob -nocomplain /usr/bin/c*]] { catch {file readlink $f} } # If we reach here we've succeeded. We used to crash above. - return ok -} ok + expr 1 +} {1} # Make sure the testfilesystem hasn't been registered. if {[testConstraint testfilesystem]} { @@ -393,12 +514,19 @@ if {[testConstraint testfilesystem]} { } } -test filesystem-3.1 {Tcl_FSRegister & Tcl_FSUnregister} testfilesystem { - set result {} - lappend result [testfilesystem 1] - lappend result [testfilesystem 0] - lappend result [catch {testfilesystem 0} msg] $msg -} {registered unregistered 1 failed} +test filesystem-3.0 {Tcl_FSRegister} testfilesystem { + resetfs + testfilesystem 1 +} {registered} +test filesystem-3.1 {Tcl_FSUnregister} testfilesystem { + resetfs + testfilesystem 1 + testfilesystem 0 +} {unregistered} +test filesystem-3.2 {Tcl_FSUnregister} testfilesystem { + resetfs + list [catch {testfilesystem 0} err] $err +} {1 failed} test filesystem-3.3 {Tcl_FSRegister} testfilesystem { testfilesystem 1 testfilesystem 1 @@ -416,113 +544,170 @@ test filesystem-3.5 {Tcl_FSUnregister} testfilesystem { lindex [file system bar] 0 } {native} -test filesystem-4.0 {testfilesystem} -constraints testfilesystem -body { - testfilesystem 1 - set filesystemReport {} - file exists foo - testfilesystem 0 - return $filesystemReport -} -match glob -result {*{access foo}} -test filesystem-4.1 {testfilesystem} -constraints testfilesystem -body { - testfilesystem 1 - set filesystemReport {} - catch {file stat foo bar} - testfilesystem 0 - return $filesystemReport -} -match glob -result {*{stat foo}} -test filesystem-4.2 {testfilesystem} -constraints testfilesystem -body { - testfilesystem 1 - set filesystemReport {} - catch {file lstat foo bar} - testfilesystem 0 - return $filesystemReport -} -match glob -result {*{lstat foo}} -test filesystem-4.3 {testfilesystem} -constraints testfilesystem -body { - testfilesystem 1 - set filesystemReport {} - catch {glob *} - testfilesystem 0 - return $filesystemReport -} -match glob -result {*{matchindirectory *}*} +test filesystem-4.0 {testfilesystem} { + -constraints testfilesystem + -match glob + -body { + testfilesystem 1 + set filesystemReport {} + file exists foo + testfilesystem 0 + set filesystemReport + } + -result {*{access foo}} +} +test filesystem-4.1 {testfilesystem} { + -constraints testfilesystem + -match glob + -body { + testfilesystem 1 + set filesystemReport {} + catch {file stat foo bar} + testfilesystem 0 + set filesystemReport + } + -result {*{stat foo}} +} +test filesystem-4.2 {testfilesystem} { + -constraints testfilesystem + -match glob + -body { + testfilesystem 1 + set filesystemReport {} + catch {file lstat foo bar} + testfilesystem 0 + set filesystemReport + } + -result {*{lstat foo}} +} +test filesystem-4.3 {testfilesystem} { + -constraints testfilesystem + -match glob + -body { + testfilesystem 1 + set filesystemReport {} + catch {glob *} + testfilesystem 0 + set filesystemReport + } + -result {*{matchindirectory *}*} +} -test filesystem-5.1 {cache and ~} -constraints testfilesystem -setup { - set orig $::env(HOME) -} -body { - set ::env(HOME) /foo/bar/blah - set testdir ~ - set res1 "Parent of ~ (/foo/bar/blah) is [file dirname $testdir]" - set ::env(HOME) /a/b/c - set res2 "Parent of ~ (/a/b/c) is [file dirname $testdir]" - list $res1 $res2 -} -cleanup { - set ::env(HOME) $orig -} -match regexp -result {{Parent of ~ \(/foo/bar/blah\) is ([a-zA-Z]:)?(/cygwin)?(/foo/bar|foo:bar)} {Parent of ~ \(/a/b/c\) is ([a-zA-Z]:)?(/cygwin)?(/a/b|a:b)}} +test filesystem-5.1 {cache and ~} { + -constraints testfilesystem + -match regexp + -body { + set orig $::env(HOME) + set ::env(HOME) /foo/bar/blah + set testdir ~ + set res1 "Parent of ~ (/foo/bar/blah) is [file dirname $testdir]" + set ::env(HOME) /a/b/c + set res2 "Parent of ~ (/a/b/c) is [file dirname $testdir]" + set ::env(HOME) $orig + list $res1 $res2 + } + -result {{Parent of ~ \(/foo/bar/blah\) is ([a-zA-Z]:)?(/foo/bar|foo:bar)} {Parent of ~ \(/a/b/c\) is ([a-zA-Z]:)?(/a/b|a:b)}} +} -test filesystem-6.1 {empty file name} -returnCodes error -body { - open "" -} -result {couldn't open "": no such file or directory} -test filesystem-6.2 {empty file name} -returnCodes error -body { - file stat "" arr -} -result {could not read "": no such file or directory} -test filesystem-6.3 {empty file name} -returnCodes error -body { - file atime "" -} -result {could not read "": no such file or directory} -test filesystem-6.4 {empty file name} -returnCodes error -body { - file attributes "" -} -result {could not read "": no such file or directory} -test filesystem-6.5 {empty file name} -returnCodes error -body { - file copy "" "" -} -result {error copying "": no such file or directory} -test filesystem-6.6 {empty file name} {file delete ""} {} -test filesystem-6.7 {empty file name} {file dirname ""} . -test filesystem-6.8 {empty file name} {file executable ""} 0 -test filesystem-6.9 {empty file name} {file exists ""} 0 -test filesystem-6.10 {empty file name} {file extension ""} {} -test filesystem-6.11 {empty file name} {file isdirectory ""} 0 -test filesystem-6.12 {empty file name} {file isfile ""} 0 -test filesystem-6.13 {empty file name} {file join ""} {} -test filesystem-6.14 {empty file name} -returnCodes error -body { - file link "" -} -result {could not read link "": no such file or directory} -test filesystem-6.15 {empty file name} -returnCodes error -body { - file lstat "" arr -} -result {could not read "": no such file or directory} -test filesystem-6.16 {empty file name} -returnCodes error -body { - file mtime "" -} -result {could not read "": no such file or directory} -test filesystem-6.17 {empty file name} -returnCodes error -body { - file mtime "" 0 -} -result {could not read "": no such file or directory} -test filesystem-6.18 {empty file name} -returnCodes error -body { - file mkdir "" -} -result {can't create directory "": no such file or directory} -test filesystem-6.19 {empty file name} {file nativename ""} {} -test filesystem-6.20 {empty file name} {file normalize ""} {} -test filesystem-6.21 {empty file name} {file owned ""} 0 -test filesystem-6.22 {empty file name} {file pathtype ""} relative -test filesystem-6.23 {empty file name} {file readable ""} 0 -test filesystem-6.24 {empty file name} -returnCodes error -body { - file readlink "" -} -result {could not read link "": no such file or directory} -test filesystem-6.25 {empty file name} -returnCodes error -body { - file rename "" "" -} -result {error renaming "": no such file or directory} -test filesystem-6.26 {empty file name} {file rootname ""} {} -test filesystem-6.27 {empty file name} -returnCodes error -body { - file separator "" -} -result {unrecognised path} -test filesystem-6.28 {empty file name} -returnCodes error -body { - file size "" -} -result {could not read "": no such file or directory} -test filesystem-6.29 {empty file name} {file split ""} {} -test filesystem-6.30 {empty file name} -returnCodes error -body { - file system "" -} -result {unrecognised path} -test filesystem-6.31 {empty file name} {file tail ""} {} -test filesystem-6.32 {empty file name} -returnCodes error -body { - file type "" -} -result {could not read "": no such file or directory} -test filesystem-6.33 {empty file name} {file writable ""} 0 +test filesystem-6.1 {empty file name} { + list [catch {open ""} msg] $msg +} {1 {couldn't open "": no such file or directory}} +test filesystem-6.2 {empty file name} { + list [catch {file stat "" arr} msg] $msg +} {1 {could not read "": no such file or directory}} +test filesystem-6.3 {empty file name} { + list [catch {file atime ""} msg] $msg +} {1 {could not read "": no such file or directory}} +test filesystem-6.4 {empty file name} { + list [catch {file attributes ""} msg] $msg +} {1 {could not read "": no such file or directory}} +test filesystem-6.5 {empty file name} { + list [catch {file copy "" ""} msg] $msg +} {1 {error copying "": no such file or directory}} +test filesystem-6.6 {empty file name} { + list [catch {file delete ""} msg] $msg +} {0 {}} +test filesystem-6.7 {empty file name} { + list [catch {file dirname ""} msg] $msg +} {0 .} +test filesystem-6.8 {empty file name} { + list [catch {file executable ""} msg] $msg +} {0 0} +test filesystem-6.9 {empty file name} { + list [catch {file exists ""} msg] $msg +} {0 0} +test filesystem-6.10 {empty file name} { + list [catch {file extension ""} msg] $msg +} {0 {}} +test filesystem-6.11 {empty file name} { + list [catch {file isdirectory ""} msg] $msg +} {0 0} +test filesystem-6.12 {empty file name} { + list [catch {file isfile ""} msg] $msg +} {0 0} +test filesystem-6.13 {empty file name} { + list [catch {file join ""} msg] $msg +} {0 {}} +test filesystem-6.14 {empty file name} { + list [catch {file link ""} msg] $msg +} {1 {could not read link "": no such file or directory}} +test filesystem-6.15 {empty file name} { + list [catch {file lstat "" arr} msg] $msg +} {1 {could not read "": no such file or directory}} +test filesystem-6.16 {empty file name} { + list [catch {file mtime ""} msg] $msg +} {1 {could not read "": no such file or directory}} +test filesystem-6.17 {empty file name} { + list [catch {file mtime "" 0} msg] $msg +} {1 {could not read "": no such file or directory}} +test filesystem-6.18 {empty file name} { + list [catch {file mkdir ""} msg] $msg +} {1 {can't create directory "": no such file or directory}} +test filesystem-6.19 {empty file name} { + list [catch {file nativename ""} msg] $msg +} {0 {}} +test filesystem-6.20 {empty file name} { + list [catch {file normalize ""} msg] $msg +} {0 {}} +test filesystem-6.21 {empty file name} { + list [catch {file owned ""} msg] $msg +} {0 0} +test filesystem-6.22 {empty file name} { + list [catch {file pathtype ""} msg] $msg +} {0 relative} +test filesystem-6.23 {empty file name} { + list [catch {file readable ""} msg] $msg +} {0 0} +test filesystem-6.24 {empty file name} { + list [catch {file readlink ""} msg] $msg +} {1 {could not readlink "": no such file or directory}} +test filesystem-6.25 {empty file name} { + list [catch {file rename "" ""} msg] $msg +} {1 {error renaming "": no such file or directory}} +test filesystem-6.26 {empty file name} { + list [catch {file rootname ""} msg] $msg +} {0 {}} +test filesystem-6.27 {empty file name} { + list [catch {file separator ""} msg] $msg +} {1 {Unrecognised path}} +test filesystem-6.28 {empty file name} { + list [catch {file size ""} msg] $msg +} {1 {could not read "": no such file or directory}} +test filesystem-6.29 {empty file name} { + list [catch {file split ""} msg] $msg +} {0 {}} +test filesystem-6.30 {empty file name} { + list [catch {file system ""} msg] $msg +} {1 {Unrecognised path}} +test filesystem-6.31 {empty file name} { + list [catch {file tail ""} msg] $msg +} {0 {}} +test filesystem-6.32 {empty file name} { + list [catch {file type ""} msg] $msg +} {1 {could not read "": no such file or directory}} +test filesystem-6.33 {empty file name} { + list [catch {file writable ""} msg] $msg +} {0 0} test filesystem-6.34 {file name with (invalid) nul character} { list [catch "open foo\x00" msg] $msg } [list 1 "couldn't open \"foo\x00\": filename is invalid on this platform"] @@ -532,113 +717,104 @@ if {[testConstraint testfilesystem]} { while {![catch {testfilesystem 0}]} {} } -test filesystem-7.1.1 {load from vfs} -setup { - set dir [pwd] -} -constraints {win testsimplefilesystem loaddll} -body { +test filesystem-7.1 {load from vfs} {win testsimplefilesystem} { # This may cause a crash on exit - cd [file dirname $::ddelib] + set dir [pwd] + cd [file dirname [info nameof]] + set dde [lindex [glob *dde*[info sharedlib]] 0] testsimplefilesystem 1 # This loads dde via a complex copy-to-temp operation - load simplefs:/[file tail $::ddelib] dde + load simplefs:/$dde dde testsimplefilesystem 0 - return ok - # The real result of this test is what happens when Tcl exits. -} -cleanup { cd $dir -} -result ok -test filesystem-7.1.2 {load from vfs, and then unload again} -setup { - set dir [pwd] -} -constraints {win testsimplefilesystem loaddll} -body { - # This may cause a crash on exit - cd [file dirname $::reglib] - testsimplefilesystem 1 - # This loads reg via a complex copy-to-temp operation - load simplefs:/[file tail $::reglib] Registry - unload simplefs:/[file tail $::reglib] - testsimplefilesystem 0 - return ok + set res "ok" # The real result of this test is what happens when Tcl exits. -} -cleanup { - cd $dir -} -result ok -test filesystem-7.2 {cross-filesystem copy from vfs maintains mtime} -setup { +} {ok} +test filesystem-7.2 {cross-filesystem copy from vfs maintains mtime} \ + {testsimplefilesystem} { set dir [pwd] cd [tcltest::temporaryDirectory] -} -constraints testsimplefilesystem -body { # We created this file several tests ago. set origtime [file mtime gorp.file] set res [file exists gorp.file] - testsimplefilesystem 1 - file delete -force theCopy - file copy simplefs:/gorp.file theCopy - testsimplefilesystem 0 - set newtime [file mtime theCopy] - lappend res [expr {$origtime == $newtime ? 1 : "$origtime != $newtime"}] -} -cleanup { - catch {file delete theCopy} + if {[catch { + testsimplefilesystem 1 + file delete -force theCopy + file copy simplefs:/gorp.file theCopy + testsimplefilesystem 0 + set newtime [file mtime theCopy] + file delete theCopy + } err]} { + lappend res $err + set newtime "" + } cd $dir -} -result {1 1} -test filesystem-7.3 {glob in simplefs} -setup { + lappend res [expr {$origtime == $newtime}] +} {1 1} +test filesystem-7.3 {glob in simplefs} testsimplefilesystem { set dir [pwd] cd [tcltest::temporaryDirectory] -} -constraints testsimplefilesystem -body { file mkdir simpledir close [open [file join simpledir simplefile] w] testsimplefilesystem 1 - glob -nocomplain -dir simplefs:/simpledir * -} -cleanup { - catch {testsimplefilesystem 0} + set res [glob -nocomplain -dir simplefs:/simpledir *] + testsimplefilesystem 0 file delete -force simpledir cd $dir -} -result {simplefs:/simpledir/simplefile} -test filesystem-7.3.1 {glob in simplefs: no path/dir} -setup { + set res +} {simplefs:/simpledir/simplefile} +test filesystem-7.3.1 {glob in simplefs: no path/dir} testsimplefilesystem { set dir [pwd] cd [tcltest::temporaryDirectory] -} -constraints testsimplefilesystem -body { file mkdir simpledir close [open [file join simpledir simplefile] w] testsimplefilesystem 1 set res [glob -nocomplain simplefs:/simpledir/*] - lappend res {*}[glob -nocomplain simplefs:/simpledir] -} -cleanup { - catch {testsimplefilesystem 0} + eval lappend res [glob -nocomplain simplefs:/simpledir] + testsimplefilesystem 0 file delete -force simpledir cd $dir -} -result {simplefs:/simpledir/simplefile simplefs:/simpledir} -test filesystem-7.3.2 {glob in simplefs: no path/dir, no subdirectory} -setup { + set res +} {simplefs:/simpledir/simplefile simplefs:/simpledir} +test filesystem-7.3.2 {glob in simplefs: no path/dir, no subdirectory} testsimplefilesystem { set dir [pwd] cd [tcltest::temporaryDirectory] -} -constraints testsimplefilesystem -body { file mkdir simpledir close [open [file join simpledir simplefile] w] testsimplefilesystem 1 - glob -nocomplain simplefs:/s* -} -cleanup { - catch {testsimplefilesystem 0} + set res [glob -nocomplain simplefs:/s*] + testsimplefilesystem 0 file delete -force simpledir cd $dir -} -match glob -result ?* -test filesystem-7.3.3 {glob in simplefs: pattern is a volume} -setup { + if {[llength $res] > 0} { + set res "ok" + } else { + set res "no files found with 'glob -nocomplain simplefs:/s*'" + } +} {ok} +test filesystem-7.3.3 {glob in simplefs: pattern is a volume} testsimplefilesystem { set dir [pwd] cd [tcltest::temporaryDirectory] -} -constraints testsimplefilesystem -body { file mkdir simpledir close [open [file join simpledir simplefile] w] testsimplefilesystem 1 - glob -nocomplain simplefs:/* -} -cleanup { + set res [glob -nocomplain simplefs:/*] testsimplefilesystem 0 file delete -force simpledir cd $dir -} -match glob -result ?* -test filesystem-7.4 {cross-filesystem file copy with -force} -setup { + if {[llength $res] > 0} { + set res "ok" + } else { + set res "no files found with 'glob -nocomplain simplefs:/*'" + } +} {ok} +test filesystem-7.4 {cross-filesystem file copy with -force} testsimplefilesystem { set dir [pwd] cd [tcltest::temporaryDirectory] set fout [open [file join simplefile] w] puts -nonewline $fout "1234567890" close $fout testsimplefilesystem 1 -} -constraints testsimplefilesystem -body { # First copy should succeed set res [catch {file copy simplefs:/simplefile file2} err] lappend res $err @@ -649,20 +825,19 @@ test filesystem-7.4 {cross-filesystem file copy with -force} -setup { lappend res [catch {file copy -force simplefs:/simplefile file2} err] lappend res $err lappend res [file exists file2] -} -cleanup { - catch {testsimplefilesystem 0} + testsimplefilesystem 0 file delete -force simplefile file delete -force file2 cd $dir -} -result {0 {} 1 {error copying "simplefs:/simplefile" to "file2": file already exists} 0 {} 1} -test filesystem-7.5 {cross-filesystem file copy with -force} -setup { + set res +} {0 {} 1 {error copying "simplefs:/simplefile" to "file2": file already exists} 0 {} 1} +test filesystem-7.5 {cross-filesystem file copy with -force} {testsimplefilesystem unix} { set dir [pwd] cd [tcltest::temporaryDirectory] set fout [open [file join simplefile] w] puts -nonewline $fout "1234567890" close $fout testsimplefilesystem 1 -} -constraints {testsimplefilesystem unix} -body { # First copy should succeed set res [catch {file copy simplefs:/simplefile file2} err] lappend res $err @@ -674,13 +849,13 @@ test filesystem-7.5 {cross-filesystem file copy with -force} -setup { lappend res [catch {file copy -force simplefs:/simplefile file2} err] lappend res $err lappend res [file exists file2] -} -cleanup { testsimplefilesystem 0 file delete -force simplefile file delete -force file2 cd $dir -} -result {0 {} 1 {error copying "simplefs:/simplefile" to "file2": file already exists} 0 {} 1} -test filesystem-7.6 {cross-filesystem dir copy with -force} -setup { + set res +} {0 {} 1 {error copying "simplefs:/simplefile" to "file2": file already exists} 0 {} 1} +test filesystem-7.6 {cross-filesystem dir copy with -force} testsimplefilesystem { set dir [pwd] cd [tcltest::temporaryDirectory] file delete -force simpledir @@ -690,7 +865,6 @@ test filesystem-7.6 {cross-filesystem dir copy with -force} -setup { puts -nonewline $fout "1234567890" close $fout testsimplefilesystem 1 -} -constraints testsimplefilesystem -body { # First copy should succeed set res [catch {file copy simplefs:/simpledir dir2} err] lappend res $err @@ -702,13 +876,13 @@ test filesystem-7.6 {cross-filesystem dir copy with -force} -setup { lappend res $err lappend res [file exists [file join dir2 simpledir]] \ [file exists [file join dir2 simpledir simplefile]] -} -cleanup { testsimplefilesystem 0 file delete -force simpledir file delete -force dir2 cd $dir -} -result {0 {} 1 {error copying "simplefs:/simpledir" to "dir2/simpledir": file already exists} 0 {} 1 1} -test filesystem-7.7 {cross-filesystem dir copy with -force} -setup { + set res +} {0 {} 1 {error copying "simplefs:/simpledir" to "dir2/simpledir": file already exists} 0 {} 1 1} +test filesystem-7.7 {cross-filesystem dir copy with -force} {testsimplefilesystem unix} { set dir [pwd] cd [tcltest::temporaryDirectory] file delete -force simpledir @@ -718,7 +892,6 @@ test filesystem-7.7 {cross-filesystem dir copy with -force} -setup { puts -nonewline $fout "1234567890" close $fout testsimplefilesystem 1 -} -constraints {testsimplefilesystem unix} -body { # First copy should succeed set res [catch {file copy simplefs:/simpledir dir2} err] lappend res $err @@ -726,41 +899,40 @@ test filesystem-7.7 {cross-filesystem dir copy with -force} -setup { lappend res [catch {file copy simplefs:/simpledir dir2} err] lappend res $err # Third copy should succeed (-force) - # I've noticed on some Unices that this only succeeds intermittently (some - # runs work, some fail). This needs examining further. + # I've noticed on some Unices that this only succeeds + # intermittently (some runs work, some fail). This needs + # examining further. lappend res [catch {file copy -force simplefs:/simpledir dir2} err] lappend res $err lappend res [file exists [file join dir2 simpledir]] \ [file exists [file join dir2 simpledir simplefile]] -} -cleanup { testsimplefilesystem 0 file delete -force simpledir file delete -force dir2 cd $dir -} -result {0 {} 1 {error copying "simplefs:/simpledir" to "dir2/simpledir": file already exists} 0 {} 1 1} + set res +} {0 {} 1 {error copying "simplefs:/simpledir" to "dir2/simpledir": file already exists} 0 {} 1 1} removeFile gorp.file -test filesystem-7.8 {vfs cd} -setup { +test filesystem-7.8 {vfs cd} testsimplefilesystem { set dir [pwd] cd [tcltest::temporaryDirectory] file delete -force simpledir file mkdir simpledir testsimplefilesystem 1 -} -constraints testsimplefilesystem -body { - # This can variously cause an infinite loop or simply have no effect at - # all (before certain bugs were fixed, of course). + # This can variously cause an infinite loop or simply have + # no effect at all (before certain bugs were fixed, of course). cd simplefs:/simpledir - pwd -} -cleanup { + set res [pwd] cd [tcltest::temporaryDirectory] testsimplefilesystem 0 file delete -force simpledir cd $dir -} -result {simplefs:/simpledir} + set res +} {simplefs:/simpledir} -test filesystem-8.1 {relative path objects and caching of pwd} -setup { +test filesystem-8.1 {relative path objects and caching of pwd} { set dir [pwd] cd [tcltest::temporaryDirectory] -} -body { makeDirectory abc makeDirectory def makeFile "contents" [file join abc foo] @@ -771,31 +943,30 @@ test filesystem-8.1 {relative path objects and caching of pwd} -setup { lappend res [file exists $f] cd .. cd def - # If we haven't cleared the object's cwd cache, Tcl will think it still - # exists. + # If we haven't cleared the object's cwd cache, Tcl + # will think it still exists. lappend res [file exists $f] lappend res [file exists $f] -} -cleanup { removeFile [file join abc foo] removeDirectory abc removeDirectory def cd $dir -} -result {1 1 0 0} -test filesystem-8.2 {relative path objects and use of pwd} -setup { + set res +} {1 1 0 0} +test filesystem-8.2 {relative path objects and use of pwd} { set origdir [pwd] cd [tcltest::temporaryDirectory] -} -body { set dir "abc" makeDirectory $dir makeFile "contents" [file join abc foo] cd $dir - file exists [lindex [glob *] 0] -} -cleanup { - cd [tcltest::temporaryDirectory] + set res [file exists [lindex [glob *] 0]] + cd .. removeFile [file join abc foo] removeDirectory abc cd $origdir -} -result 1 + set res +} {1} test filesystem-8.3 {path objects and empty string} { set anchor "" set dst foo @@ -811,7 +982,7 @@ proc TestFind1 {d f} { lappend res "is dir a dir? [file isdirectory $d]" set r2 [file exists [file join $d $f]] lappend res "[file join $d $f] found: $r2" - return $res + set res } proc TestFind2 {d f} { set r1 [file exists [file join $d $f]] @@ -819,74 +990,67 @@ proc TestFind2 {d f} { lappend res "is dir a dir? [file isdirectory [file join $d]]" set r2 [file exists [file join $d $f]] lappend res "[file join $d $f] found: $r2" - return $res + set res } -test filesystem-9.1 {path objects and join and object rep} -setup { +test filesystem-9.1 {path objects and join and object rep} { set origdir [pwd] cd [tcltest::temporaryDirectory] -} -body { file mkdir [file join a b c] - TestFind1 a [file join b . c] -} -cleanup { + set res [TestFind1 a [file join b . c]] file delete -force a cd $origdir -} -result {{a/b/./c found: 1} {is dir a dir? 1} {a/b/./c found: 1}} -test filesystem-9.2 {path objects and join and object rep} -setup { + set res +} {{a/b/./c found: 1} {is dir a dir? 1} {a/b/./c found: 1}} +test filesystem-9.2 {path objects and join and object rep} { set origdir [pwd] cd [tcltest::temporaryDirectory] -} -body { file mkdir [file join a b c] - TestFind2 a [file join b . c] -} -cleanup { + set res [TestFind2 a [file join b . c]] file delete -force a cd $origdir -} -result {{a/b/./c found: 1} {is dir a dir? 1} {a/b/./c found: 1}} -test filesystem-9.2.1 {path objects and join and object rep} -setup { + set res +} {{a/b/./c found: 1} {is dir a dir? 1} {a/b/./c found: 1}} +test filesystem-9.2.1 {path objects and join and object rep} { set origdir [pwd] cd [tcltest::temporaryDirectory] -} -body { file mkdir [file join a b c] - TestFind2 a [file join b .] -} -cleanup { + set res [TestFind2 a [file join b .]] file delete -force a cd $origdir -} -result {{a/b/. found: 1} {is dir a dir? 1} {a/b/. found: 1}} -test filesystem-9.3 {path objects and join and object rep} -setup { + set res +} {{a/b/. found: 1} {is dir a dir? 1} {a/b/. found: 1}} +test filesystem-9.3 {path objects and join and object rep} { set origdir [pwd] cd [tcltest::temporaryDirectory] -} -body { file mkdir [file join a b c] - TestFind1 a [file join b .. b c] -} -cleanup { + set res [TestFind1 a [file join b .. b c]] file delete -force a cd $origdir -} -result {{a/b/../b/c found: 1} {is dir a dir? 1} {a/b/../b/c found: 1}} -test filesystem-9.4 {path objects and join and object rep} -setup { + set res +} {{a/b/../b/c found: 1} {is dir a dir? 1} {a/b/../b/c found: 1}} +test filesystem-9.4 {path objects and join and object rep} { set origdir [pwd] cd [tcltest::temporaryDirectory] -} -body { file mkdir [file join a b c] - TestFind2 a [file join b .. b c] -} -cleanup { + set res [TestFind2 a [file join b .. b c]] file delete -force a cd $origdir -} -result {{a/b/../b/c found: 1} {is dir a dir? 1} {a/b/../b/c found: 1}} -test filesystem-9.5 {path objects and file tail and object rep} -setup { + set res +} {{a/b/../b/c found: 1} {is dir a dir? 1} {a/b/../b/c found: 1}} +test filesystem-9.5 {path objects and file tail and object rep} { set origdir [pwd] cd [tcltest::temporaryDirectory] -} -body { file mkdir dgp close [open dgp/test w] foreach relative [glob -nocomplain [file join * test]] { set absolute [file join [pwd] $relative] set res [list [file tail $absolute] "test"] } - return $res -} -cleanup { - file delete -force dgp + file delete -force dgp cd $origdir -} -result {test test} + set res +} {test test} test filesystem-9.6 {path objects and file tail and object rep} win { set res {} set p "C:\\toto" @@ -894,11 +1058,10 @@ test filesystem-9.6 {path objects and file tail and object rep} win { file isdirectory $p lappend res [file join $p toto] } {C:/toto/toto C:/toto/toto} -test filesystem-9.7 {path objects and glob and file tail and tilde} -setup { +test filesystem-9.7 {path objects and glob and file tail and tilde} { set res {} set origdir [pwd] cd [tcltest::temporaryDirectory] -} -body { file mkdir tilde close [open tilde/~testNotExist w] cd tilde @@ -907,16 +1070,15 @@ test filesystem-9.7 {path objects and glob and file tail and tilde} -setup { lappend res $file lappend res [file exists $file] [catch {file tail $file} r] $r lappend res [catch {file tail $file} r] $r -} -cleanup { - cd [tcltest::temporaryDirectory] + cd .. file delete -force tilde cd $origdir -} -result {0 1 {user "testNotExist" doesn't exist} ~testNotExist 0 1 {user "testNotExist" doesn't exist} 1 {user "testNotExist" doesn't exist}} -test filesystem-9.8 {path objects and glob and file tail and tilde} -setup { + set res +} {0 1 {user "testNotExist" doesn't exist} ~testNotExist 0 1 {user "testNotExist" doesn't exist} 1 {user "testNotExist" doesn't exist}} +test filesystem-9.8 {path objects and glob and file tail and tilde} { set res {} set origdir [pwd] cd [tcltest::temporaryDirectory] -} -body { file mkdir tilde close [open tilde/~testNotExist w] cd tilde @@ -925,16 +1087,15 @@ test filesystem-9.8 {path objects and glob and file tail and tilde} -setup { lappend res $file1 $file2 lappend res [catch {file tail $file1} r] $r lappend res [catch {file tail $file2} r] $r -} -cleanup { - cd [tcltest::temporaryDirectory] + cd .. file delete -force tilde cd $origdir -} -result {~testNotExist ~testNotExist 1 {user "testNotExist" doesn't exist} 1 {user "testNotExist" doesn't exist}} -test filesystem-9.9 {path objects and glob and file tail and tilde} -setup { + set res +} {~testNotExist ~testNotExist 1 {user "testNotExist" doesn't exist} 1 {user "testNotExist" doesn't exist}} +test filesystem-9.9 {path objects and glob and file tail and tilde} { set res {} set origdir [pwd] cd [tcltest::temporaryDirectory] -} -body { file mkdir tilde close [open tilde/~testNotExist w] cd tilde @@ -943,24 +1104,18 @@ test filesystem-9.9 {path objects and glob and file tail and tilde} -setup { lappend res [catch {file exists $file1} r] $r lappend res [catch {file exists $file2} r] $r lappend res [string equal $file1 $file2] -} -cleanup { - cd [tcltest::temporaryDirectory] + cd .. file delete -force tilde cd $origdir -} -result {0 0 0 0 1} - -# ---------------------------------------------------------------------- + set res +} {0 0 0 0 1} test filesystem-10.1 {Bug 3414754} { string match */ [file join [pwd] foo/] } 0 cleanupTests -unset -nocomplain drive drives +unset -nocomplain drive } namespace delete ::tcl::test::fileSystem return - -# Local Variables: -# mode: tcl -# End: |