diff options
Diffstat (limited to 'tests/fileSystem.test')
| -rw-r--r-- | tests/fileSystem.test | 977 |
1 files changed, 406 insertions, 571 deletions
diff --git a/tests/fileSystem.test b/tests/fileSystem.test index d34de8f..10895b2 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,6 +19,17 @@ 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]] @@ -31,44 +42,39 @@ makeDirectory [file join dir.dir dirinside.dir] makeFile "test file in directory" [file join dir.dir inside.file] testConstraint unusedDrive 0 -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 +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 + } } - } - unset i vols - # The variable 'drive' will be used below -} -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 + set dir [pwd] + try { + foreach vol [file volumes] { + if {![catch {cd $vol}]} { + lappend drives $vol + } + } + testConstraint moreThanOneDrive [llength $drives] + } finally { + cd $dir + } } - # The variable 'drives' will be used below - unset vol - cd $dir - unset dir -} +} ::tcl::test::fileSystem} proc testPathEqual {one two} { if {$one eq $two} { - return 1 - } else { - return "not equal: $one $two" + return "ok" } + return "not equal: $one $two" } testConstraint hasLinks [expr {![catch { @@ -88,6 +94,8 @@ 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] @@ -98,37 +106,38 @@ 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]] -} {1} +} ok test filesystem-1.3 {link normalisation} {hasLinks} { testPathEqual [file normalize [file join dir.dir foo]] \ [file normalize [file join dir.link foo]] -} {1} +} ok test filesystem-1.4 {link normalisation} {hasLinks} { testPathEqual [file normalize [file join dir.dir inside.file]] \ [file normalize [file join dir.link inside.file]] -} {1} +} ok test filesystem-1.5 {link normalisation} {hasLinks} { testPathEqual [file normalize [file join dir.dir linkinside.file]] \ [file normalize [file join dir.dir linkinside.file]] -} {1} +} ok 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]] -} {1} +} ok 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} {unix hasLinks} { +test filesystem-1.9 {link normalisation} -setup { 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]] -} {1} +} -result ok test filesystem-1.10 {link normalisation: double link} -constraints { unix hasLinks } -body { @@ -137,14 +146,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 {1} +} -result ok 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]] -} {1} +} ok test filesystem-1.12 {file new native path} {} { for {set i 0} {$i < 10} {incr i} { foreach f [lsort [glob -nocomplain -type l *]] { @@ -201,62 +210,49 @@ 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 ..} {hasLinks} { +test filesystem-1.26 {link normalisation: link and ..} -setup { 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] - 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} + testPathEqual [file normalize [file join dir2 foo x]] \ + [file normalize [file join dir2.link .. x]] +} -result 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] - 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} { + 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 { 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 [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} { + 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 { 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 first ".." $res] != -1} { - set res "$res must not contain '..'" - } else { - set res "ok" + if {[string match *..* $res]} { + return "$res must not contain '..'" } -} {ok} + return "ok" +} -result {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]] -} {1} +} ok file delete -force dir2.file file delete -force dir2.link file delete -force link.file dir.link @@ -265,9 +261,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} { - list [catch {file normalize ~noonewiththisname} err] $err -} {1 {user "noonewiththisname" doesn't exist}} +test filesystem-1.30 {normalisation of nonexistent user} -body { + file normalize ~noonewiththisname +} -returnCodes error -result {user "noonewiththisname" doesn't exist} test filesystem-1.31 {link normalisation: link near filesystem root} {testsetplatform} { testsetplatform unix file normalize /foo/../bar @@ -280,8 +276,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 @@ -289,215 +285,88 @@ test filesystem-1.33 {link normalisation: link near filesystem root} {testsetpla if {[testConstraint testsetplatform]} { testsetplatform $platform } -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 '/./'} { +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 { set fname "/abc/./def/./ghi/./asda/.././.././asd/x/../../../../....." - 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" + file norm $fname +} -match regexp -result {^(?:[^/]|/(?:[^/]|$))+$} +test filesystem-1.38 {file normalisation with volume relative} -setup { set dir [pwd] +} -constraints {win moreThanOneDrive} -body { + set path "[string range [lindex $drives 0] 0 1]foo" cd [lindex $drives 1] - set res [file norm $path] + file norm $path +} -cleanup { cd $dir - set res -} "[lindex $drives 0]foo" -test filesystem-1.39 {file normalisation with volume relative} {win} { - set drv C:/ - set dir [lindex [glob -type d -dir $drv *] 0] +} -result "[lindex $drives 0]foo" +test filesystem-1.39 {file normalisation with volume relative} -setup { set old [pwd] - cd $dir - set res [file norm [string range $drv 0 1]] +} -constraints {win} -body { + set drv C:/ + cd [lindex [glob -type d -dir $drv *] 0] + file norm [string range $drv 0 1] +} -cleanup { cd $old - if {[string index $res end] eq "/"} { - set res "Bad normalized path: $res" - } else { - set res "ok" - } -} {ok} +} -match regexp -result {.*[^/]} test filesystem-1.40 {file normalisation with repeated separators} { - 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} + testPathEqual [file norm foo////bar] [file norm foo/bar] +} ok test filesystem-1.41 {file normalisation with repeated separators} {win} { - 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} + testPathEqual [file norm foo\\\\\\bar] [file norm foo/bar] +} ok test filesystem-1.42 {file normalisation .. beyond root (Bug 1379287)} { - 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} + testPathEqual [file norm /xxx/..] [file norm /] +} ok test filesystem-1.42.1 {file normalisation .. beyond root (Bug 1379287)} { - 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} + testPathEqual [file norm /xxx/../] [file norm /] +} ok test filesystem-1.43 {file normalisation .. beyond root (Bug 1379287)} { - 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} + testPathEqual [file norm /xxx/foo/../..] [file norm /] +} ok test filesystem-1.43.1 {file normalisation .. beyond root (Bug 1379287)} { - 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} + testPathEqual [file norm /xxx/foo/../../] [file norm /] +} ok test filesystem-1.44 {file normalisation .. beyond root (Bug 1379287)} { - 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} + testPathEqual [file norm /xxx/foo/../../bar] [file norm /bar] +} ok test filesystem-1.45 {file normalisation .. beyond root (Bug 1379287)} { - 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} + testPathEqual [file norm /xxx/../../bar] [file norm /bar] +} ok test filesystem-1.46 {file normalisation .. beyond root (Bug 1379287)} { - 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} + testPathEqual [file norm /xxx/../bar] [file norm /bar] +} ok test filesystem-1.47 {file normalisation .. beyond root (Bug 1379287)} { - 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} + testPathEqual [file norm /..] [file norm /] +} ok test filesystem-1.48 {file normalisation .. beyond root (Bug 1379287)} { - 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} + testPathEqual [file norm /../] [file norm /] +} ok test filesystem-1.49 {file normalisation .. beyond root (Bug 1379287)} { - 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} + testPathEqual [file norm /.] [file norm /] +} ok test filesystem-1.50 {file normalisation .. beyond root (Bug 1379287)} { - 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} + testPathEqual [file norm /./] [file norm /] +} ok test filesystem-1.51 {file normalisation .. beyond root (Bug 1379287)} { - 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} + testPathEqual [file norm /../..] [file norm /] +} ok test filesystem-1.51.1 {file normalisation .. beyond root (Bug 1379287)} { - 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} + 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 @@ -514,8 +383,8 @@ test filesystem-2.0 {new native path} {unix} { catch {file readlink $f} } # If we reach here we've succeeded. We used to crash above. - expr 1 -} {1} + return ok +} ok # Make sure the testfilesystem hasn't been registered. if {[testConstraint testfilesystem]} { @@ -524,19 +393,12 @@ if {[testConstraint testfilesystem]} { } } -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.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.3 {Tcl_FSRegister} testfilesystem { testfilesystem 1 testfilesystem 1 @@ -554,170 +416,113 @@ test filesystem-3.5 {Tcl_FSUnregister} testfilesystem { lindex [file system bar] 0 } {native} -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-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-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-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-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.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.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"] @@ -727,104 +532,113 @@ if {[testConstraint testfilesystem]} { while {![catch {testfilesystem 0}]} {} } -test filesystem-7.1 {load from vfs} {win testsimplefilesystem} { - # This may cause a crash on exit +test filesystem-7.1.1 {load from vfs} -setup { set dir [pwd] - cd [file dirname [info nameof]] - set dde [lindex [glob *dde*[info sharedlib]] 0] +} -constraints {win testsimplefilesystem loaddll} -body { + # This may cause a crash on exit + cd [file dirname $::ddelib] testsimplefilesystem 1 # This loads dde via a complex copy-to-temp operation - load simplefs:/$dde dde + load simplefs:/[file tail $::ddelib] dde testsimplefilesystem 0 + return ok + # The real result of this test is what happens when Tcl exits. +} -cleanup { cd $dir - set res "ok" +} -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 # The real result of this test is what happens when Tcl exits. -} {ok} -test filesystem-7.2 {cross-filesystem copy from vfs maintains mtime} \ - {testsimplefilesystem} { +} -cleanup { + cd $dir +} -result ok +test filesystem-7.2 {cross-filesystem copy from vfs maintains mtime} -setup { 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] - 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 "" - } + 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} cd $dir - lappend res [expr {$origtime == $newtime}] -} {1 1} -test filesystem-7.3 {glob in simplefs} testsimplefilesystem { +} -result {1 1} +test filesystem-7.3 {glob in simplefs} -setup { 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 -dir simplefs:/simpledir *] - testsimplefilesystem 0 + glob -nocomplain -dir simplefs:/simpledir * +} -cleanup { + catch {testsimplefilesystem 0} file delete -force simpledir cd $dir - set res -} {simplefs:/simpledir/simplefile} -test filesystem-7.3.1 {glob in simplefs: no path/dir} testsimplefilesystem { +} -result {simplefs:/simpledir/simplefile} +test filesystem-7.3.1 {glob in simplefs: no path/dir} -setup { 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/*] - eval lappend res [glob -nocomplain simplefs:/simpledir] - testsimplefilesystem 0 + lappend res {*}[glob -nocomplain simplefs:/simpledir] +} -cleanup { + catch {testsimplefilesystem 0} file delete -force simpledir cd $dir - set res -} {simplefs:/simpledir/simplefile simplefs:/simpledir} -test filesystem-7.3.2 {glob in simplefs: no path/dir, no subdirectory} testsimplefilesystem { +} -result {simplefs:/simpledir/simplefile simplefs:/simpledir} +test filesystem-7.3.2 {glob in simplefs: no path/dir, no subdirectory} -setup { 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:/s*] - testsimplefilesystem 0 + glob -nocomplain simplefs:/s* +} -cleanup { + catch {testsimplefilesystem 0} file delete -force simpledir cd $dir - 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 { +} -match glob -result ?* +test filesystem-7.3.3 {glob in simplefs: pattern is a volume} -setup { 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:/*] + glob -nocomplain simplefs:/* +} -cleanup { testsimplefilesystem 0 file delete -force simpledir cd $dir - 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 { +} -match glob -result ?* +test filesystem-7.4 {cross-filesystem file copy with -force} -setup { 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 @@ -835,19 +649,20 @@ test filesystem-7.4 {cross-filesystem file copy with -force} testsimplefilesyste lappend res [catch {file copy -force simplefs:/simplefile file2} err] lappend res $err lappend res [file exists file2] - testsimplefilesystem 0 +} -cleanup { + catch {testsimplefilesystem 0} file delete -force simplefile file delete -force file2 cd $dir - 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} { +} -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 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 @@ -859,13 +674,13 @@ test filesystem-7.5 {cross-filesystem file copy with -force} {testsimplefilesyst 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 - 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 { +} -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 dir [pwd] cd [tcltest::temporaryDirectory] file delete -force simpledir @@ -875,6 +690,7 @@ test filesystem-7.6 {cross-filesystem dir copy with -force} testsimplefilesystem 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 @@ -886,13 +702,13 @@ test filesystem-7.6 {cross-filesystem dir copy with -force} testsimplefilesystem 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 - 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} { +} -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 dir [pwd] cd [tcltest::temporaryDirectory] file delete -force simpledir @@ -902,6 +718,7 @@ test filesystem-7.7 {cross-filesystem dir copy with -force} {testsimplefilesyste 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 @@ -909,40 +726,41 @@ test filesystem-7.7 {cross-filesystem dir copy with -force} {testsimplefilesyste 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 - set res -} {0 {} 1 {error copying "simplefs:/simpledir" to "dir2/simpledir": file already exists} 0 {} 1 1} +} -result {0 {} 1 {error copying "simplefs:/simpledir" to "dir2/simpledir": file already exists} 0 {} 1 1} removeFile gorp.file -test filesystem-7.8 {vfs cd} testsimplefilesystem { +test filesystem-7.8 {vfs cd} -setup { set dir [pwd] cd [tcltest::temporaryDirectory] file delete -force simpledir file mkdir simpledir testsimplefilesystem 1 - # This can variously cause an infinite loop or simply have - # no effect at all (before certain bugs were fixed, of course). +} -constraints testsimplefilesystem -body { + # This can variously cause an infinite loop or simply have no effect at + # all (before certain bugs were fixed, of course). cd simplefs:/simpledir - set res [pwd] + pwd +} -cleanup { cd [tcltest::temporaryDirectory] testsimplefilesystem 0 file delete -force simpledir cd $dir - set res -} {simplefs:/simpledir} +} -result {simplefs:/simpledir} -test filesystem-8.1 {relative path objects and caching of pwd} { +test filesystem-8.1 {relative path objects and caching of pwd} -setup { set dir [pwd] cd [tcltest::temporaryDirectory] +} -body { makeDirectory abc makeDirectory def makeFile "contents" [file join abc foo] @@ -953,30 +771,31 @@ test filesystem-8.1 {relative path objects and caching of pwd} { 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 - set res -} {1 1 0 0} -test filesystem-8.2 {relative path objects and use of pwd} { +} -result {1 1 0 0} +test filesystem-8.2 {relative path objects and use of pwd} -setup { set origdir [pwd] cd [tcltest::temporaryDirectory] +} -body { set dir "abc" makeDirectory $dir makeFile "contents" [file join abc foo] cd $dir - set res [file exists [lindex [glob *] 0]] - cd .. + file exists [lindex [glob *] 0] +} -cleanup { + cd [tcltest::temporaryDirectory] removeFile [file join abc foo] removeDirectory abc cd $origdir - set res -} {1} +} -result 1 test filesystem-8.3 {path objects and empty string} { set anchor "" set dst foo @@ -992,7 +811,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" - set res + return $res } proc TestFind2 {d f} { set r1 [file exists [file join $d $f]] @@ -1000,67 +819,74 @@ 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" - set res + return $res } -test filesystem-9.1 {path objects and join and object rep} { +test filesystem-9.1 {path objects and join and object rep} -setup { set origdir [pwd] cd [tcltest::temporaryDirectory] +} -body { file mkdir [file join a b c] - set res [TestFind1 a [file join b . c]] + TestFind1 a [file join b . c] +} -cleanup { file delete -force a cd $origdir - 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} { +} -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 origdir [pwd] cd [tcltest::temporaryDirectory] +} -body { file mkdir [file join a b c] - set res [TestFind2 a [file join b . c]] + TestFind2 a [file join b . c] +} -cleanup { file delete -force a cd $origdir - 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} { +} -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 origdir [pwd] cd [tcltest::temporaryDirectory] +} -body { file mkdir [file join a b c] - set res [TestFind2 a [file join b .]] + TestFind2 a [file join b .] +} -cleanup { file delete -force a cd $origdir - 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} { +} -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 origdir [pwd] cd [tcltest::temporaryDirectory] +} -body { file mkdir [file join a b c] - set res [TestFind1 a [file join b .. b c]] + TestFind1 a [file join b .. b c] +} -cleanup { file delete -force a cd $origdir - 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} { +} -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 origdir [pwd] cd [tcltest::temporaryDirectory] +} -body { file mkdir [file join a b c] - set res [TestFind2 a [file join b .. b c]] + TestFind2 a [file join b .. b c] +} -cleanup { file delete -force a cd $origdir - 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} { +} -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 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 cd $origdir - set res -} {test test} +} -result {test test} test filesystem-9.6 {path objects and file tail and object rep} win { set res {} set p "C:\\toto" @@ -1068,10 +894,11 @@ 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} { +test filesystem-9.7 {path objects and glob and file tail and tilde} -setup { set res {} set origdir [pwd] cd [tcltest::temporaryDirectory] +} -body { file mkdir tilde close [open tilde/~testNotExist w] cd tilde @@ -1080,15 +907,16 @@ test filesystem-9.7 {path objects and glob and file tail and tilde} { lappend res $file lappend res [file exists $file] [catch {file tail $file} r] $r lappend res [catch {file tail $file} r] $r - cd .. +} -cleanup { + cd [tcltest::temporaryDirectory] file delete -force tilde cd $origdir - 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} { +} -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 {} set origdir [pwd] cd [tcltest::temporaryDirectory] +} -body { file mkdir tilde close [open tilde/~testNotExist w] cd tilde @@ -1097,15 +925,16 @@ test filesystem-9.8 {path objects and glob and file tail and tilde} { lappend res $file1 $file2 lappend res [catch {file tail $file1} r] $r lappend res [catch {file tail $file2} r] $r - cd .. +} -cleanup { + cd [tcltest::temporaryDirectory] file delete -force tilde cd $origdir - 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} { +} -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 {} set origdir [pwd] cd [tcltest::temporaryDirectory] +} -body { file mkdir tilde close [open tilde/~testNotExist w] cd tilde @@ -1114,18 +943,24 @@ test filesystem-9.9 {path objects and glob and file tail and tilde} { lappend res [catch {file exists $file1} r] $r lappend res [catch {file exists $file2} r] $r lappend res [string equal $file1 $file2] - cd .. +} -cleanup { + cd [tcltest::temporaryDirectory] file delete -force tilde cd $origdir - set res -} {0 0 0 0 1} +} -result {0 0 0 0 1} + +# ---------------------------------------------------------------------- test filesystem-10.1 {Bug 3414754} { string match */ [file join [pwd] foo/] } 0 cleanupTests -unset -nocomplain drive +unset -nocomplain drive drives } namespace delete ::tcl::test::fileSystem return + +# Local Variables: +# mode: tcl +# End: |