diff options
Diffstat (limited to 'tests/cmdAH.test')
| -rw-r--r-- | tests/cmdAH.test | 558 |
1 files changed, 306 insertions, 252 deletions
diff --git a/tests/cmdAH.test b/tests/cmdAH.test index 28e396f..fb0fefc 100644 --- a/tests/cmdAH.test +++ b/tests/cmdAH.test @@ -15,7 +15,14 @@ if {[lsearch [namespace children] ::tcltest] == -1} { namespace import -force ::tcltest::* } -tcltest::testConstraint testchmod [string equal testchmod [info commands testchmod]] +testConstraint testchmod [llength [info commands testchmod]] +testConstraint testsetplatform [llength [info commands testsetplatform]] +testConstraint testvolumetype [llength [info commands testvolumetype]] +testConstraint linkDirectory [expr { + ![testConstraint win] || + ([string index $tcl_platform(osVersion) 0] >= 5 + && [lindex [file system [temporaryDirectory]] 1] eq "NTFS") +}] global env set cmdAHwd [pwd] @@ -32,10 +39,19 @@ test cmdAH-0.2 {Tcl_BreakObjCmd, success} { test cmdAH-1.1 {Tcl_CatchObjCmd, errors} { list [catch {catch} msg] $msg -} {1 {wrong # args: should be "catch command ?varName?"}} +} {1 {wrong # args: should be "catch script ?resultVarName? ?optionVarName?"}} test cmdAH-1.2 {Tcl_CatchObjCmd, errors} { list [catch {catch foo bar baz} msg] $msg -} {1 {wrong # args: should be "catch command ?varName?"}} +} {0 1} +test cmdAH-1.3 {Tcl_CatchObjCmd, errors} { + list [catch {catch foo bar baz spaz} msg] $msg +} {1 {wrong # args: should be "catch script ?resultVarName? ?optionVarName?"}} +test cmdAH-1.4 {Bug 3595576} { + catch {catch {} -> noSuchNs::var} +} 1 +test cmdAH-1.5 {Bug 3595576} { + catch {catch error -> noSuchNs::var} +} 1 test cmdAH-2.1 {Tcl_CdObjCmd} { list [catch {cd foo bar} msg] $msg @@ -110,7 +126,7 @@ test cmdAH-4.1 {Tcl_EncodingObjCmd} { } {1 {wrong # args: should be "encoding option ?arg ...?"}} test cmdAH-4.2 {Tcl_EncodingObjCmd} { list [catch {encoding foo} msg] $msg -} {1 {bad option "foo": must be convertfrom, convertto, names, or system}} +} {1 {bad option "foo": must be convertfrom, convertto, dirs, names, or system}} test cmdAH-4.3 {Tcl_EncodingObjCmd} { list [catch {encoding convertto} msg] $msg } {1 {wrong # args: should be "encoding convertto ?encoding? data"}} @@ -191,16 +207,16 @@ test cmdAH-6.2 {Tcl_FileObjCmd: volumes} { set result 1 } } {1} -test cmdAH-6.3 {Tcl_FileObjCmd: volumes} {macOrUnix} { +test cmdAH-6.3 {Tcl_FileObjCmd: volumes} {unix} { set volumeList [file volumes] catch [list glob -nocomplain [lindex $volumeList 0]*] } {0} -test cmdAH-6.4 {Tcl_FileObjCmd: volumes} winOnly { +test cmdAH-6.4 {Tcl_FileObjCmd: volumes} win { set volumeList [string tolower [file volumes]] list [catch {lsearch $volumeList "c:/"} element] [expr $element != -1] [catch {list glob -nocomplain [lindex $volumeList $element]*}] } {0 1 0} -test cmdAH-6.5 {cd} {unixOnly nonPortable} { +test cmdAH-6.5 {cd} {unix nonPortable} { set dir [pwd] cd / set res [pwd] @@ -222,115 +238,111 @@ test cmdAH-7.1 {Tcl_FileObjCmd - file attrs} { # dirname -if {[info commands testsetplatform] == {}} { - puts "This application hasn't been compiled with the \"testsetplatform\"" - puts "command, so I can't test Tcl_FileObjCmd etc." -} else { -test cmdAH-8.1 {Tcl_FileObjCmd: dirname} { +test cmdAH-8.1 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform unix list [catch {file dirname a b} msg] $msg } {1 {wrong # args: should be "file dirname name"}} -test cmdAH-8.2 {Tcl_FileObjCmd: dirname} { +test cmdAH-8.2 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform unix file dirname /a/b } /a -test cmdAH-8.3 {Tcl_FileObjCmd: dirname} { +test cmdAH-8.3 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform unix file dirname {} } . -test cmdAH-8.5 {Tcl_FileObjCmd: dirname} { +test cmdAH-8.5 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform win file dirname {} } . -test cmdAH-8.6 {Tcl_FileObjCmd: dirname} { +test cmdAH-8.6 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform unix file dirname .def } . -test cmdAH-8.8 {Tcl_FileObjCmd: dirname} { +test cmdAH-8.8 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform win file dirname a } . -test cmdAH-8.9 {Tcl_FileObjCmd: dirname} { +test cmdAH-8.9 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform unix file dirname a/b/c.d } a/b -test cmdAH-8.10 {Tcl_FileObjCmd: dirname} { +test cmdAH-8.10 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform unix file dirname a/b.c/d } a/b.c -test cmdAH-8.11 {Tcl_FileObjCmd: dirname} { +test cmdAH-8.11 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform unix file dirname /. } / -test cmdAH-8.12 {Tcl_FileObjCmd: dirname} { +test cmdAH-8.12 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform unix list [catch {file dirname /} msg] $msg } {0 /} -test cmdAH-8.13 {Tcl_FileObjCmd: dirname} { +test cmdAH-8.13 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform unix list [catch {file dirname /foo} msg] $msg } {0 /} -test cmdAH-8.14 {Tcl_FileObjCmd: dirname} { +test cmdAH-8.14 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform unix list [catch {file dirname //foo} msg] $msg } {0 /} -test cmdAH-8.15 {Tcl_FileObjCmd: dirname} { +test cmdAH-8.15 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform unix list [catch {file dirname //foo/bar} msg] $msg } {0 /foo} -test cmdAH-8.16 {Tcl_FileObjCmd: dirname} { +test cmdAH-8.16 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform unix list [catch {file dirname {//foo\/bar/baz}} msg] $msg } {0 {/foo\/bar}} -test cmdAH-8.17 {Tcl_FileObjCmd: dirname} { +test cmdAH-8.17 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform unix list [catch {file dirname {//foo\/bar/baz/blat}} msg] $msg } {0 {/foo\/bar/baz}} -test cmdAH-8.18 {Tcl_FileObjCmd: dirname} { +test cmdAH-8.18 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform unix list [catch {file dirname /foo//} msg] $msg } {0 /} -test cmdAH-8.19 {Tcl_FileObjCmd: dirname} { +test cmdAH-8.19 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform unix list [catch {file dirname ./a} msg] $msg } {0 .} -test cmdAH-8.20 {Tcl_FileObjCmd: dirname} { +test cmdAH-8.20 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform unix list [catch {file dirname a/.a} msg] $msg } {0 a} -test cmdAH-8.21 {Tcl_FileObjCmd: dirname} { +test cmdAH-8.21 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform windows list [catch {file dirname c:foo} msg] $msg } {0 c:} -test cmdAH-8.22 {Tcl_FileObjCmd: dirname} { +test cmdAH-8.22 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform windows list [catch {file dirname c:} msg] $msg } {0 c:} -test cmdAH-8.23 {Tcl_FileObjCmd: dirname} { +test cmdAH-8.23 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform windows list [catch {file dirname c:/} msg] $msg } {0 c:/} -test cmdAH-8.24 {Tcl_FileObjCmd: dirname} { +test cmdAH-8.24 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform windows list [catch {file dirname {c:\foo}} msg] $msg } {0 c:/} -test cmdAH-8.25 {Tcl_FileObjCmd: dirname} { +test cmdAH-8.25 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform windows list [catch {file dirname {//foo/bar/baz}} msg] $msg } {0 //foo/bar} -test cmdAH-8.26 {Tcl_FileObjCmd: dirname} { +test cmdAH-8.26 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform windows list [catch {file dirname {//foo/bar}} msg] $msg } {0 //foo/bar} -test cmdAH-8.38 {Tcl_FileObjCmd: dirname} { +test cmdAH-8.38 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform unix list [catch {file dirname ~/foo} msg] $msg } {0 ~} -test cmdAH-8.39 {Tcl_FileObjCmd: dirname} { +test cmdAH-8.39 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform unix list [catch {file dirname ~bar/foo} msg] $msg } {0 ~bar} -test cmdAH-8.43 {Tcl_FileObjCmd: dirname} { +test cmdAH-8.43 {Tcl_FileObjCmd: dirname} testsetplatform { global env set temp $env(HOME) set env(HOME) "/homewontexist/test" @@ -339,7 +351,7 @@ test cmdAH-8.43 {Tcl_FileObjCmd: dirname} { set env(HOME) $temp set result } {0 /homewontexist} -test cmdAH-8.44 {Tcl_FileObjCmd: dirname} { +test cmdAH-8.44 {Tcl_FileObjCmd: dirname} testsetplatform { global env set temp $env(HOME) set env(HOME) "~" @@ -349,114 +361,133 @@ test cmdAH-8.44 {Tcl_FileObjCmd: dirname} { set result } {0 ~} test cmdAH-8.45 {Tcl_FileObjCmd: dirname} { - global env - set temp $env(HOME) - set env(HOME) "/homewontexist/test" - testsetplatform windows - set result [list [catch {file dirname ~} msg] $msg] - set env(HOME) $temp - set result -} {0 /homewontexist} + -constraints {win testsetplatform} + -match regexp + -setup { + set temp $::env(HOME) + } + -body { + set ::env(HOME) "/homewontexist/test" + testsetplatform windows + file dirname ~ + } + -cleanup { + set ::env(HOME) $temp + } + -result {([a-zA-Z]:?)/homewontexist} +} +test cmdAH-8.46 {Tcl_FileObjCmd: dirname} { + set f [file normalize [info nameof]] + file exists $f + set res1 [file dirname [file join $f foo/bar]] + set res2 [file dirname "${f}/foo/bar"] + if {$res1 eq $res2} { + set res "ok" + } else { + set res "file dirname problem, $res1, $res2 not equal" + } + set res +} {ok} # tail -test cmdAH-9.1 {Tcl_FileObjCmd: tail} { +test cmdAH-9.1 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform unix list [catch {file tail a b} msg] $msg } {1 {wrong # args: should be "file tail name"}} -test cmdAH-9.2 {Tcl_FileObjCmd: tail} { +test cmdAH-9.2 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform unix file tail /a/b } b -test cmdAH-9.3 {Tcl_FileObjCmd: tail} { +test cmdAH-9.3 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform unix file tail {} } {} -test cmdAH-9.5 {Tcl_FileObjCmd: tail} { +test cmdAH-9.5 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform win file tail {} } {} -test cmdAH-9.6 {Tcl_FileObjCmd: tail} { +test cmdAH-9.6 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform unix file tail .def } .def -test cmdAH-9.8 {Tcl_FileObjCmd: tail} { +test cmdAH-9.8 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform win file tail a } a -test cmdAH-9.9 {Tcl_FileObjCmd: tail} { +test cmdAH-9.9 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform unix file ta a/b/c.d } c.d -test cmdAH-9.10 {Tcl_FileObjCmd: tail} { +test cmdAH-9.10 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform unix file tail a/b.c/d } d -test cmdAH-9.11 {Tcl_FileObjCmd: tail} { +test cmdAH-9.11 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform unix file tail /. } . -test cmdAH-9.12 {Tcl_FileObjCmd: tail} { +test cmdAH-9.12 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform unix file tail / } {} -test cmdAH-9.13 {Tcl_FileObjCmd: tail} { +test cmdAH-9.13 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform unix file tail /foo } foo -test cmdAH-9.14 {Tcl_FileObjCmd: tail} { +test cmdAH-9.14 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform unix file tail //foo } foo -test cmdAH-9.15 {Tcl_FileObjCmd: tail} { +test cmdAH-9.15 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform unix file tail //foo/bar } bar -test cmdAH-9.16 {Tcl_FileObjCmd: tail} { +test cmdAH-9.16 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform unix file tail {//foo\/bar/baz} } baz -test cmdAH-9.17 {Tcl_FileObjCmd: tail} { +test cmdAH-9.17 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform unix file tail {//foo\/bar/baz/blat} } blat -test cmdAH-9.18 {Tcl_FileObjCmd: tail} { +test cmdAH-9.18 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform unix file tail /foo// } foo -test cmdAH-9.19 {Tcl_FileObjCmd: tail} { +test cmdAH-9.19 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform unix file tail ./a } a -test cmdAH-9.20 {Tcl_FileObjCmd: tail} { +test cmdAH-9.20 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform unix file tail a/.a } .a -test cmdAH-9.21 {Tcl_FileObjCmd: tail} { +test cmdAH-9.21 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform windows file tail c:foo } foo -test cmdAH-9.22 {Tcl_FileObjCmd: tail} { +test cmdAH-9.22 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform windows file tail c: } {} -test cmdAH-9.23 {Tcl_FileObjCmd: tail} { +test cmdAH-9.23 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform windows file tail c:/ } {} -test cmdAH-9.24 {Tcl_FileObjCmd: tail} { +test cmdAH-9.24 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform windows file tail {c:\foo} } foo -test cmdAH-9.25 {Tcl_FileObjCmd: tail} { +test cmdAH-9.25 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform windows file tail {//foo/bar/baz} } baz -test cmdAH-9.26 {Tcl_FileObjCmd: tail} { +test cmdAH-9.26 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform windows file tail {//foo/bar} } {} -test cmdAH-9.42 {Tcl_FileObjCmd: tail} { +test cmdAH-9.42 {Tcl_FileObjCmd: tail} testsetplatform { global env set temp $env(HOME) set env(HOME) "/home/test" @@ -465,7 +496,7 @@ test cmdAH-9.42 {Tcl_FileObjCmd: tail} { set env(HOME) $temp set result } test -test cmdAH-9.43 {Tcl_FileObjCmd: tail} { +test cmdAH-9.43 {Tcl_FileObjCmd: tail} testsetplatform { global env set temp $env(HOME) set env(HOME) "~" @@ -474,7 +505,7 @@ test cmdAH-9.43 {Tcl_FileObjCmd: tail} { set env(HOME) $temp set result } {} -test cmdAH-9.44 {Tcl_FileObjCmd: tail} { +test cmdAH-9.44 {Tcl_FileObjCmd: tail} testsetplatform { global env set temp $env(HOME) set env(HOME) "/home/test" @@ -483,227 +514,227 @@ test cmdAH-9.44 {Tcl_FileObjCmd: tail} { set env(HOME) $temp set result } test -test cmdAH-9.46 {Tcl_FileObjCmd: tail} { +test cmdAH-9.46 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform unix file tail {f.oo\bar/baz.bat} } baz.bat -test cmdAH-9.47 {Tcl_FileObjCmd: tail} { +test cmdAH-9.47 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform windows file tail c:foo } foo -test cmdAH-9.48 {Tcl_FileObjCmd: tail} { +test cmdAH-9.48 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform windows file tail c: } {} -test cmdAH-9.49 {Tcl_FileObjCmd: tail} { +test cmdAH-9.49 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform windows file tail c:/foo } foo -test cmdAH-9.50 {Tcl_FileObjCmd: tail} { +test cmdAH-9.50 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform windows file tail {c:/foo\bar} } bar -test cmdAH-9.51 {Tcl_FileObjCmd: tail} { +test cmdAH-9.51 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform windows file tail {foo\bar} } bar # rootname -test cmdAH-10.1 {Tcl_FileObjCmd: rootname} { +test cmdAH-10.1 {Tcl_FileObjCmd: rootname} testsetplatform { testsetplatform unix list [catch {file rootname a b} msg] $msg } {1 {wrong # args: should be "file rootname name"}} -test cmdAH-10.2 {Tcl_FileObjCmd: rootname} { +test cmdAH-10.2 {Tcl_FileObjCmd: rootname} testsetplatform { testsetplatform unix file rootname {} } {} -test cmdAH-10.3 {Tcl_FileObjCmd: rootname} { +test cmdAH-10.3 {Tcl_FileObjCmd: rootname} testsetplatform { testsetplatform unix file ro foo } foo -test cmdAH-10.4 {Tcl_FileObjCmd: rootname} { +test cmdAH-10.4 {Tcl_FileObjCmd: rootname} testsetplatform { testsetplatform unix file rootname foo. } foo -test cmdAH-10.5 {Tcl_FileObjCmd: rootname} { +test cmdAH-10.5 {Tcl_FileObjCmd: rootname} testsetplatform { testsetplatform unix file rootname .foo } {} -test cmdAH-10.6 {Tcl_FileObjCmd: rootname} { +test cmdAH-10.6 {Tcl_FileObjCmd: rootname} testsetplatform { testsetplatform unix file rootname abc.def } abc -test cmdAH-10.7 {Tcl_FileObjCmd: rootname} { +test cmdAH-10.7 {Tcl_FileObjCmd: rootname} testsetplatform { testsetplatform unix file rootname abc.def.ghi } abc.def -test cmdAH-10.8 {Tcl_FileObjCmd: rootname} { +test cmdAH-10.8 {Tcl_FileObjCmd: rootname} testsetplatform { testsetplatform unix file rootname a/b/c.d } a/b/c -test cmdAH-10.9 {Tcl_FileObjCmd: rootname} { +test cmdAH-10.9 {Tcl_FileObjCmd: rootname} testsetplatform { testsetplatform unix file rootname a/b.c/d } a/b.c/d -test cmdAH-10.10 {Tcl_FileObjCmd: rootname} { +test cmdAH-10.10 {Tcl_FileObjCmd: rootname} testsetplatform { testsetplatform unix file rootname a/b.c/ } a/b.c/ -test cmdAH-10.23 {Tcl_FileObjCmd: rootname} { +test cmdAH-10.23 {Tcl_FileObjCmd: rootname} testsetplatform { testsetplatform windows file rootname {} } {} -test cmdAH-10.24 {Tcl_FileObjCmd: rootname} { +test cmdAH-10.24 {Tcl_FileObjCmd: rootname} testsetplatform { testsetplatform windows file ro foo } foo -test cmdAH-10.25 {Tcl_FileObjCmd: rootname} { +test cmdAH-10.25 {Tcl_FileObjCmd: rootname} testsetplatform { testsetplatform windows file rootname foo. } foo -test cmdAH-10.26 {Tcl_FileObjCmd: rootname} { +test cmdAH-10.26 {Tcl_FileObjCmd: rootname} testsetplatform { testsetplatform windows file rootname .foo } {} -test cmdAH-10.27 {Tcl_FileObjCmd: rootname} { +test cmdAH-10.27 {Tcl_FileObjCmd: rootname} testsetplatform { testsetplatform windows file rootname abc.def } abc -test cmdAH-10.28 {Tcl_FileObjCmd: rootname} { +test cmdAH-10.28 {Tcl_FileObjCmd: rootname} testsetplatform { testsetplatform windows file rootname abc.def.ghi } abc.def -test cmdAH-10.29 {Tcl_FileObjCmd: rootname} { +test cmdAH-10.29 {Tcl_FileObjCmd: rootname} testsetplatform { testsetplatform windows file rootname a/b/c.d } a/b/c -test cmdAH-10.30 {Tcl_FileObjCmd: rootname} { +test cmdAH-10.30 {Tcl_FileObjCmd: rootname} testsetplatform { testsetplatform windows file rootname a/b.c/d } a/b.c/d -test cmdAH-10.31 {Tcl_FileObjCmd: rootname} { +test cmdAH-10.31 {Tcl_FileObjCmd: rootname} testsetplatform { testsetplatform windows file rootname a\\b.c\\ } a\\b.c\\ -test cmdAH-10.32 {Tcl_FileObjCmd: rootname} { +test cmdAH-10.32 {Tcl_FileObjCmd: rootname} testsetplatform { testsetplatform windows file rootname a\\b\\c.d } a\\b\\c -test cmdAH-10.33 {Tcl_FileObjCmd: rootname} { +test cmdAH-10.33 {Tcl_FileObjCmd: rootname} testsetplatform { testsetplatform windows file rootname a\\b.c\\d } a\\b.c\\d -test cmdAH-10.34 {Tcl_FileObjCmd: rootname} { +test cmdAH-10.34 {Tcl_FileObjCmd: rootname} testsetplatform { testsetplatform windows file rootname a\\b.c\\ } a\\b.c\\ set num 35 foreach outer { {} a .a a. a.a } { - foreach inner { {} a .a a. a.a } { - set thing [format %s/%s $outer $inner] -; test cmdAH-6.$num {Tcl_FileObjCmd: rootname and extension options} { - testsetplatform unix - format %s%s [file rootname $thing] [file ext $thing] - } $thing - set num [expr $num+1] - } + foreach inner { {} a .a a. a.a } { + set thing [format %s/%s $outer $inner] + ;test cmdAH-10.$num {Tcl_FileObjCmd: rootname and extension options} testsetplatform " + testsetplatform unix + [list format %s%s [file rootname $thing] [file ext $thing]] + " $thing + incr num + } } # extension -test cmdAH-11.1 {Tcl_FileObjCmd: extension} { +test cmdAH-11.1 {Tcl_FileObjCmd: extension} testsetplatform { testsetplatform unix list [catch {file extension a b} msg] $msg } {1 {wrong # args: should be "file extension name"}} -test cmdAH-11.2 {Tcl_FileObjCmd: extension} { +test cmdAH-11.2 {Tcl_FileObjCmd: extension} testsetplatform { testsetplatform unix file extension {} } {} -test cmdAH-11.3 {Tcl_FileObjCmd: extension} { +test cmdAH-11.3 {Tcl_FileObjCmd: extension} testsetplatform { testsetplatform unix file ext foo } {} -test cmdAH-11.4 {Tcl_FileObjCmd: extension} { +test cmdAH-11.4 {Tcl_FileObjCmd: extension} testsetplatform { testsetplatform unix file extension foo. } . -test cmdAH-11.5 {Tcl_FileObjCmd: extension} { +test cmdAH-11.5 {Tcl_FileObjCmd: extension} testsetplatform { testsetplatform unix file extension .foo } .foo -test cmdAH-11.6 {Tcl_FileObjCmd: extension} { +test cmdAH-11.6 {Tcl_FileObjCmd: extension} testsetplatform { testsetplatform unix file extension abc.def } .def -test cmdAH-11.7 {Tcl_FileObjCmd: extension} { +test cmdAH-11.7 {Tcl_FileObjCmd: extension} testsetplatform { testsetplatform unix file extension abc.def.ghi } .ghi -test cmdAH-11.8 {Tcl_FileObjCmd: extension} { +test cmdAH-11.8 {Tcl_FileObjCmd: extension} testsetplatform { testsetplatform unix file extension a/b/c.d } .d -test cmdAH-11.9 {Tcl_FileObjCmd: extension} { +test cmdAH-11.9 {Tcl_FileObjCmd: extension} testsetplatform { testsetplatform unix file extension a/b.c/d } {} -test cmdAH-11.10 {Tcl_FileObjCmd: extension} { +test cmdAH-11.10 {Tcl_FileObjCmd: extension} testsetplatform { testsetplatform unix file extension a/b.c/ } {} -test cmdAH-11.23 {Tcl_FileObjCmd: extension} { +test cmdAH-11.23 {Tcl_FileObjCmd: extension} testsetplatform { testsetplatform windows file extension {} } {} -test cmdAH-11.24 {Tcl_FileObjCmd: extension} { +test cmdAH-11.24 {Tcl_FileObjCmd: extension} testsetplatform { testsetplatform windows file ext foo } {} -test cmdAH-11.25 {Tcl_FileObjCmd: extension} { +test cmdAH-11.25 {Tcl_FileObjCmd: extension} testsetplatform { testsetplatform windows file extension foo. } . -test cmdAH-11.26 {Tcl_FileObjCmd: extension} { +test cmdAH-11.26 {Tcl_FileObjCmd: extension} testsetplatform { testsetplatform windows file extension .foo } .foo -test cmdAH-11.27 {Tcl_FileObjCmd: extension} { +test cmdAH-11.27 {Tcl_FileObjCmd: extension} testsetplatform { testsetplatform windows file extension abc.def } .def -test cmdAH-11.28 {Tcl_FileObjCmd: extension} { +test cmdAH-11.28 {Tcl_FileObjCmd: extension} testsetplatform { testsetplatform windows file extension abc.def.ghi } .ghi -test cmdAH-11.29 {Tcl_FileObjCmd: extension} { +test cmdAH-11.29 {Tcl_FileObjCmd: extension} testsetplatform { testsetplatform windows file extension a/b/c.d } .d -test cmdAH-11.30 {Tcl_FileObjCmd: extension} { +test cmdAH-11.30 {Tcl_FileObjCmd: extension} testsetplatform { testsetplatform windows file extension a/b.c/d } {} -test cmdAH-11.31 {Tcl_FileObjCmd: extension} { +test cmdAH-11.31 {Tcl_FileObjCmd: extension} testsetplatform { testsetplatform windows file extension a\\b.c\\ } {} -test cmdAH-11.32 {Tcl_FileObjCmd: extension} { +test cmdAH-11.32 {Tcl_FileObjCmd: extension} testsetplatform { testsetplatform windows file extension a\\b\\c.d } .d -test cmdAH-11.33 {Tcl_FileObjCmd: extension} { +test cmdAH-11.33 {Tcl_FileObjCmd: extension} testsetplatform { testsetplatform windows file extension a\\b.c\\d } {} -test cmdAH-11.34 {Tcl_FileObjCmd: extension} { +test cmdAH-11.34 {Tcl_FileObjCmd: extension} testsetplatform { testsetplatform windows file extension a\\b.c\\ } {} set num 35 foreach value {a..b a...b a.c..b ..b} result {.b .b .b .b} { foreach p {unix windows} { -; test cmdAH-7.$num {Tcl_FileObjCmd: extension} " + ;test cmdAH-11.$num {Tcl_FileObjCmd: extension} testsetplatform " testsetplatform $p file extension $value " $result @@ -713,98 +744,103 @@ foreach value {a..b a...b a.c..b ..b} result {.b .b .b .b} { # pathtype -test cmdAH-12.1 {Tcl_FileObjCmd: pathtype} { +test cmdAH-12.1 {Tcl_FileObjCmd: pathtype} testsetplatform { testsetplatform unix list [catch {file pathtype a b} msg] $msg } {1 {wrong # args: should be "file pathtype name"}} -test cmdAH-12.2 {Tcl_FileObjCmd: pathtype} { +test cmdAH-12.2 {Tcl_FileObjCmd: pathtype} testsetplatform { testsetplatform unix file pathtype /a } absolute -test cmdAH-12.3 {Tcl_FileObjCmd: pathtype} { +test cmdAH-12.3 {Tcl_FileObjCmd: pathtype} testsetplatform { testsetplatform unix file p a } relative -test cmdAH-12.4 {Tcl_FileObjCmd: pathtype} { +test cmdAH-12.4 {Tcl_FileObjCmd: pathtype} testsetplatform { testsetplatform windows file pathtype c:a } volumerelative # split -test cmdAH-13.1 {Tcl_FileObjCmd: split} { +test cmdAH-13.1 {Tcl_FileObjCmd: split} testsetplatform { testsetplatform unix list [catch {file split a b} msg] $msg } {1 {wrong # args: should be "file split name"}} -test cmdAH-13.2 {Tcl_FileObjCmd: split} { +test cmdAH-13.2 {Tcl_FileObjCmd: split} testsetplatform { testsetplatform unix file split a } a -test cmdAH-13.3 {Tcl_FileObjCmd: split} { +test cmdAH-13.3 {Tcl_FileObjCmd: split} testsetplatform { testsetplatform unix file split a/b } {a b} # join -test cmdAH-14.1 {Tcl_FileObjCmd: join} { +test cmdAH-14.1 {Tcl_FileObjCmd: join} testsetplatform { testsetplatform unix file join a } a -test cmdAH-14.2 {Tcl_FileObjCmd: join} { +test cmdAH-14.2 {Tcl_FileObjCmd: join} testsetplatform { testsetplatform unix file join a b } a/b -test cmdAH-14.3 {Tcl_FileObjCmd: join} { +test cmdAH-14.3 {Tcl_FileObjCmd: join} testsetplatform { testsetplatform unix file join a b c d } a/b/c/d # error handling of Tcl_TranslateFileName -test cmdAH-15.1 {Tcl_FileObjCmd} { +test cmdAH-15.1 {Tcl_FileObjCmd} testsetplatform { testsetplatform unix list [catch {file atime ~_bad_user} msg] $msg } {1 {user "_bad_user" doesn't exist}} -testsetplatform $platform -} +catch {testsetplatform $platform} # readable set gorpfile [makeFile abcde gorp.file] set dirfile [makeDirectory dir.file] -if {[info commands testchmod] == {}} { - puts "This application hasn't been compiled with the \"testchmod\"" - puts "command, so I can't test Tcl_FileObjCmd etc." -} else { -test cmdAH-16.1 {Tcl_FileObjCmd: readable} {testchmod} { - list [catch {file readable a b} msg] $msg -} {1 {wrong # args: should be "file readable name"}} -testchmod 0444 $gorpfile -test cmdAH-16.2 {Tcl_FileObjCmd: readable} {testchmod} { - file readable $gorpfile -} 1 -testchmod 0333 $gorpfile -test cmdAH-16.3 {Tcl_FileObjCmd: readable} {unixOnly notRoot testchmod} { - file reada $gorpfile -} 0 +test cmdAH-16.1 {Tcl_FileObjCmd: readable} { + -body {list [catch {file readable a b} msg] $msg} + -result {1 {wrong # args: should be "file readable name"}} +} +test cmdAH-16.2 {Tcl_FileObjCmd: readable} { + -constraints testchmod + -setup {testchmod 0444 $gorpfile} + -body {file readable $gorpfile} + -result 1 +} +test cmdAH-16.3 {Tcl_FileObjCmd: readable} { + -constraints {unix notRoot testchmod} + -setup {testchmod 0333 $gorpfile} + -body {file reada $gorpfile} + -result 0 +} # writable -test cmdAH-17.1 {Tcl_FileObjCmd: writable} {testchmod} { - list [catch {file writable a b} msg] $msg -} {1 {wrong # args: should be "file writable name"}} -testchmod 0555 $gorpfile -test cmdAH-17.2 {Tcl_FileObjCmd: writable} {notRoot testchmod} { - file writable $gorpfile -} 0 -testchmod 0222 $gorpfile -test cmdAH-17.3 {Tcl_FileObjCmd: writable} {testchmod} { - file writable $gorpfile -} 1 +test cmdAH-17.1 {Tcl_FileObjCmd: writable} { + -body {list [catch {file writable a b} msg] $msg} + -result {1 {wrong # args: should be "file writable name"}} +} +test cmdAH-17.2 {Tcl_FileObjCmd: writable} { + -constraints {notRoot testchmod} + -setup {testchmod 0555 $gorpfile} + -body {file writable $gorpfile} + -result 0 } +test cmdAH-17.3 {Tcl_FileObjCmd: writable} { + -constraints testchmod + -setup {testchmod 0222 $gorpfile} + -body {file writable $gorpfile} + -result 1 +} + # executable @@ -813,13 +849,13 @@ removeDirectory $dirfile set dirfile [makeDirectory dir.file] set gorpfile [makeFile abcde gorp.file] -test cmdAH-18.1 {Tcl_FileObjCmd: executable} {testchmod} { +test cmdAH-18.1 {Tcl_FileObjCmd: executable} {} { list [catch {file executable a b} msg] $msg } {1 {wrong # args: should be "file executable name"}} -test cmdAH-18.2 {Tcl_FileObjCmd: executable} {testchmod notRoot} { +test cmdAH-18.2 {Tcl_FileObjCmd: executable} {notRoot} { file executable $gorpfile } 0 -test cmdAH-18.3 {Tcl_FileObjCmd: executable} {unixOnly testchmod} { +test cmdAH-18.3 {Tcl_FileObjCmd: executable} {unix testchmod} { # Only on unix will setting the execute bit on a regular file # cause that file to be executable. @@ -827,7 +863,7 @@ test cmdAH-18.3 {Tcl_FileObjCmd: executable} {unixOnly testchmod} { file exe $gorpfile } 1 -test cmdAH-18.5 {Tcl_FileObjCmd: executable} {winOnly testchmod} { +test cmdAH-18.5 {Tcl_FileObjCmd: executable} {win} { # On pc, must be a .exe, .com, etc. set x [file exe $gorpfile] @@ -836,7 +872,16 @@ test cmdAH-18.5 {Tcl_FileObjCmd: executable} {winOnly testchmod} { removeFile $gorpexe set x } {0 1} -test cmdAH-18.6 {Tcl_FileObjCmd: executable} {testchmod} { +test cmdAH-18.5.1 {Tcl_FileObjCmd: executable} {win} { + # On pc, must be a .exe, .com, etc. + + set x [file exe $gorpfile] + set gorpexe [makeFile foo gorp.exe] + lappend x [file exe [string toupper $gorpexe]] + removeFile $gorpexe + set x +} {0 1} +test cmdAH-18.6 {Tcl_FileObjCmd: executable} {} { # Directories are always executable. file exe $dirfile @@ -869,19 +914,14 @@ test cmdAH-19.5 {Tcl_FileObjCmd: exists} { } 1 # nativename -if {[info commands testsetplatform] == {}} { - puts "This application hasn't been compiled with the \"testsetplatform\"" - puts "command, so I can't test Tcl_FileObjCmd etc." -} else { -test cmdAH-19.6 {Tcl_FileObjCmd: nativename} { +test cmdAH-19.6 {Tcl_FileObjCmd: nativename} testsetplatform { testsetplatform unix list [catch {file nativename a/b} msg] $msg [testsetplatform $platform] } {0 a/b {}} -test cmdAH-19.7 {Tcl_FileObjCmd: nativename} { +test cmdAH-19.7 {Tcl_FileObjCmd: nativename} testsetplatform { testsetplatform windows list [catch {file nativename a/b} msg] $msg [testsetplatform $platform] } {0 {a\b} {}} -} test cmdAH-19.9 {Tcl_FileObjCmd: ~ : exists} { file exists ~nOsUcHuSeR @@ -895,7 +935,7 @@ test cmdAH-19.10 {Tcl_FileObjCmd: ~ : nativename} { # directory in order to guarantee (?) a local file system: some # NFS file systems won't do the stuff below correctly. -test cmdAH-19.11 {Tcl_FileObjCmd: exists} {unixOnly notRoot} { +test cmdAH-19.11 {Tcl_FileObjCmd: exists} {unix notRoot} { file delete -force /tmp/tcl.foo.dir/file file delete -force /tmp/tcl.foo.dir makeDirectory /tmp/tcl.foo.dir @@ -919,7 +959,12 @@ catch {file attributes $gorpfile -permissions 0765} # atime -set file [makeFile "data" touch.me] +# avoid problems with non-local filesystems +if {[testConstraint unix] && [file exists /tmp]} { + set file [makeFile "data" touch.me /tmp] +} else { + set file [makeFile "data" touch.me] +} test cmdAH-20.1 {Tcl_FileObjCmd: atime} { list [catch {file atime a b c} msg] $msg @@ -937,18 +982,23 @@ test cmdAH-20.3 {Tcl_FileObjCmd: atime} { test cmdAH-20.4 {Tcl_FileObjCmd: atime} { list [catch {file atime $file notint} msg] $msg } {1 {expected integer but got "notint"}} -test cmdAH-20.5 {Tcl_FileObjCmd: atime touch} {unixOrPc} { - if {[string equal $tcl_platform(platform) "windows"]} { - set old [pwd] - cd $::tcltest::temporaryDirectory - if {![string equal "NTFS" [testvolumetype]]} { - # Windows FAT doesn't understand atime, but NTFS does - # May also fail for Windows on NFS mounted disks - cd $old - return 1 - } +test cmdAH-20.5 {Tcl_FileObjCmd: atime touch} {unix} { + set atime [file atime $file] + after 1100; # pause a sec to notice change in atime + set newatime [clock seconds] + set modatime [file atime $file $newatime] + expr {$newatime == $modatime ? 1 : "$newatime != $modatime"} +} 1 +test cmdAH-20.6 {Tcl_FileObjCmd: atime touch} {win testvolumetype} { + set old [pwd] + cd $::tcltest::temporaryDirectory + if {"NTFS" ne [testvolumetype]} { + # Windows FAT doesn't understand atime, but NTFS does + # May also fail for Windows on NFS mounted disks cd $old + return 1 } + cd $old set atime [file atime $file] after 1100; # pause a sec to notice change in atime set newatime [clock seconds] @@ -956,7 +1006,12 @@ test cmdAH-20.5 {Tcl_FileObjCmd: atime touch} {unixOrPc} { expr {$newatime == $modatime ? 1 : "$newatime != $modatime"} } 1 -removeFile touch.me +if {[testConstraint unix] && [file exists /tmp]} { + removeFile touch.me /tmp +} else { + removeFile touch.me +} + # isdirectory test cmdAH-21.1 {Tcl_FileObjCmd: isdirectory} { @@ -987,12 +1042,12 @@ test cmdAH-23.1 {Tcl_FileObjCmd: lstat} { test cmdAH-23.2 {Tcl_FileObjCmd: lstat} { list [catch {file lstat a b c} msg] $msg } {1 {wrong # args: should be "file lstat name varName"}} -test cmdAH-23.3 {Tcl_FileObjCmd: lstat} {unixOnly nonPortable} { +test cmdAH-23.3 {Tcl_FileObjCmd: lstat} {unix nonPortable} { catch {unset stat} file lstat $linkfile stat lsort [array names stat] } {atime ctime dev gid ino mode mtime nlink size type uid} -test cmdAH-23.4 {Tcl_FileObjCmd: lstat} {unixOnly nonPortable} { +test cmdAH-23.4 {Tcl_FileObjCmd: lstat} {unix nonPortable} { catch {unset stat} file lstat $linkfile stat list $stat(nlink) [expr $stat(mode)&0777] $stat(type) @@ -1051,17 +1106,19 @@ proc waitForEvenSecondForFAT {} { # timings. :^( # This procedure based on work by Helmut Giese - global tcl_platform - if {$tcl_platform(platform) ne "windows"} {return} - if {[lindex [file system [temporaryDirectory]] 1] == "NTFS"} {return} - # Assume non-NTFS means FAT{12,16,32} and hence in need of special help - set start [clock seconds] - while {1} { - set now [clock seconds] - if {$now!=$start && !($now & 1)} { - return + if { + [testConstraint win] + && [lindex [file system [temporaryDirectory]] 1] ne "NTFS" + } then { + # Assume non-NTFS means FAT{12,16,32} and hence in need of special help + set start [clock seconds] + while {1} { + set now [clock seconds] + if {$now!=$start && !($now & 1)} { + break + } + after 50 } - after 50 } } set file [makeFile "data" touch.me] @@ -1108,16 +1165,13 @@ test cmdAH-24.4 {Tcl_FileObjCmd: mtime} { test cmdAH-24.5 {Tcl_FileObjCmd: mtime} { # Under Unix, use a file in /tmp to avoid clock skew due to NFS. # On other platforms, just use a file in the local directory. - - if {[string equal $tcl_platform(platform) "unix"]} { + if {[testConstraint unix]} { set name /tmp/tcl.test.[pid] } else { set name [file join [temporaryDirectory] tf] } - # Make sure that a new file's time is correct. 10 seconds variance # is allowed used due to slow networks or clock skew on a network drive. - file delete -force $name close [open $name w] set a [expr abs([clock seconds]-[file mtime $name])<10] @@ -1127,14 +1181,14 @@ test cmdAH-24.5 {Tcl_FileObjCmd: mtime} { test cmdAH-24.7 {Tcl_FileObjCmd: mtime} { list [catch {file mtime $file notint} msg] $msg } {1 {expected integer but got "notint"}} -test cmdAH-24.8 {Tcl_FileObjCmd: mtime touch} macOrUnix { +test cmdAH-24.8 {Tcl_FileObjCmd: mtime touch} unix { set mtime [file mtime $file] after 1100; # pause a sec to notice change in mtime set newmtime [clock seconds] set modmtime [file mtime $file $newmtime] expr {$newmtime == $modmtime ? 1 : "$newmtime != $modmtime"} } 1 -test cmdAH-24.9 {Tcl_FileObjCmd: mtime touch with non-ascii chars} macOrUnix { +test cmdAH-24.9 {Tcl_FileObjCmd: mtime touch with non-ascii chars} unix { set oldfile $file # introduce some non-ascii characters. append file \u2022 @@ -1150,7 +1204,7 @@ test cmdAH-24.9 {Tcl_FileObjCmd: mtime touch with non-ascii chars} macOrUnix { } expr {$newmtime == $modmtime ? 1 : "$newmtime != $modmtime"} } 1 -test cmdAH-24.10 {Tcl_FileObjCmd: mtime touch} winOnly { +test cmdAH-24.10 {Tcl_FileObjCmd: mtime touch} win { waitForEvenSecondForFAT set mtime [file mtime $file] after 2100; # pause two secs to notice change in mtime on FAT fs'es @@ -1158,7 +1212,7 @@ test cmdAH-24.10 {Tcl_FileObjCmd: mtime touch} winOnly { set modmtime [file mtime $file $newmtime] expr {$newmtime == $modmtime ? 1 : "$newmtime != $modmtime"} } 1 -test cmdAH-24.11 {Tcl_FileObjCmd: mtime touch with non-ascii chars} winOnly { +test cmdAH-24.11 {Tcl_FileObjCmd: mtime touch with non-ascii chars} win { waitForEvenSecondForFAT set oldfile $file # introduce some non-ascii characters. @@ -1177,10 +1231,8 @@ test cmdAH-24.11 {Tcl_FileObjCmd: mtime touch with non-ascii chars} winOnly { } 1 removeFile touch.me rename waitForEvenSecondForFAT {} - test cmdAH-24.12 {Tcl_FileObjCmd: mtime and daylight savings} { set name [file join [temporaryDirectory] clockchange] - file delete -force $name close [open $name w] set time [clock scan "21:00:00 October 30 2004 GMT"] @@ -1189,31 +1241,37 @@ test cmdAH-24.12 {Tcl_FileObjCmd: mtime and daylight savings} { file delete $name expr {$newmtime == $time ? 1 : "$newmtime != $time"} } {1} - # bug 1420432: setting mtime fails for directories on windows. -test cmdAH-24.13 {Tcl_FileObjCmd: directory mtime} { +test cmdAH-24.13 {Tcl_FileObjCmd: directory mtime} -setup { set dirname [file join [temporaryDirectory] tmp[pid]] file delete -force $dirname +} -constraints tempNotWin -body { file mkdir $dirname - set res [catch { - set old [file mtime $dirname] - file mtime $dirname 0 - set new [file mtime $dirname] - list $new [expr {$old != $new}] - } err] + set old [file mtime $dirname] + file mtime $dirname 0 + set new [file mtime $dirname] + list $new [expr {$old != $new}] +} -cleanup { file delete -force $dirname - list $res $err -} {0 {0 1}} +} -result {0 1} # owned test cmdAH-25.1 {Tcl_FileObjCmd: owned} { list [catch {file owned a b} msg] $msg } {1 {wrong # args: should be "file owned name"}} -test cmdAH-25.2 {Tcl_FileObjCmd: owned} { +test cmdAH-25.2 {Tcl_FileObjCmd: owned} -constraints win -body { file owned $gorpfile -} 1 -test cmdAH-25.3 {Tcl_FileObjCmd: owned} {unixOnly notRoot} { +} -result 1 +test cmdAH-25.2.1 {Tcl_FileObjCmd: owned} -constraints unix -setup { + # Avoid problems with AFS + set tmpfile [makeFile "data" touch.me /tmp] +} -body { + file owned $tmpfile +} -cleanup { + removeFile touch.me /tmp +} -result 1 +test cmdAH-25.3 {Tcl_FileObjCmd: owned} {unix notRoot} { file owned / } 0 @@ -1222,14 +1280,14 @@ test cmdAH-25.3 {Tcl_FileObjCmd: owned} {unixOnly notRoot} { test cmdAH-26.1 {Tcl_FileObjCmd: readlink} { list [catch {file readlink a b} msg] $msg } {1 {wrong # args: should be "file readlink name"}} -test cmdAH-26.2 {Tcl_FileObjCmd: readlink} {unixOnly nonPortable} { +test cmdAH-26.2 {Tcl_FileObjCmd: readlink} {unix nonPortable} { file readlink $linkfile } $gorpfile -test cmdAH-26.3 {Tcl_FileObjCmd: readlink errors} {unixOnly nonPortable} { +test cmdAH-26.3 {Tcl_FileObjCmd: readlink errors} {unix nonPortable} { list [catch {file readlink _bogus_} msg] [string tolower $msg] \ [string tolower $errorCode] } {1 {could not readlink "_bogus_": no such file or directory} {posix enoent {no such file or directory}}} -test cmdAH-26.5 {Tcl_FileObjCmd: readlink errors} {winOnly nonPortable} { +test cmdAH-26.5 {Tcl_FileObjCmd: readlink errors} {win nonPortable} { list [catch {file readlink _bogus_} msg] [string tolower $msg] \ [string tolower $errorCode] } {1 {could not readlink "_bogus_": invalid argument} {posix einval {invalid argument}}} @@ -1267,7 +1325,9 @@ test cmdAH-28.2 {Tcl_FileObjCmd: stat} { } {1 {wrong # args: should be "file stat name varName"} NONE} test cmdAH-28.3 {Tcl_FileObjCmd: stat} { catch {unset stat} + set stat(blocks) [set stat(blksize) {}] file stat $gorpfile stat + unset stat(blocks) stat(blksize) lsort [array names stat] } {atime ctime dev gid ino mode mtime nlink size type uid} test cmdAH-28.4 {Tcl_FileObjCmd: stat} { @@ -1275,10 +1335,10 @@ test cmdAH-28.4 {Tcl_FileObjCmd: stat} { file stat $gorpfile stat list $stat(nlink) $stat(size) $stat(type) } {1 12 file} -test cmdAH-28.5 {Tcl_FileObjCmd: stat} {unixOnly} { +test cmdAH-28.5 {Tcl_FileObjCmd: stat} {unix} { catch {unset stat} file stat $gorpfile stat - expr $stat(mode)&0777 + expr $stat(mode)&0o777 } {501} test cmdAH-28.6 {Tcl_FileObjCmd: stat} { string tolower [list [catch {file stat _bogus_ stat} msg] \ @@ -1298,7 +1358,7 @@ test cmdAH-28.8 {Tcl_FileObjCmd: stat} { removeFile $filename set x } 1 -test cmdAH-28.9 {Tcl_FileObjCmd: stat} winOnly { +test cmdAH-28.9 {Tcl_FileObjCmd: stat} win { # stat of root directory was failing. # don't care about answer, just that test runs. @@ -1314,7 +1374,7 @@ test cmdAH-28.9 {Tcl_FileObjCmd: stat} winOnly { file stat c:/ stat file stat c:/. stat } {} -test cmdAH-28.10 {Tcl_FileObjCmd: stat} {winOnly nonPortable} { +test cmdAH-28.10 {Tcl_FileObjCmd: stat} {win nonPortable} { # stat of root directory was failing. # don't care about answer, just that test runs. @@ -1322,7 +1382,7 @@ test cmdAH-28.10 {Tcl_FileObjCmd: stat} {winOnly nonPortable} { file stat //pop/$env(USERNAME)/ stat file stat //pop/$env(USERNAME)/. stat } {} -test cmdAH-28.11 {Tcl_FileObjCmd: stat} {winOnly nonPortable} { +test cmdAH-28.11 {Tcl_FileObjCmd: stat} {win nonPortable} { # stat of network directory was returning id of current local drive. set old [pwd] @@ -1351,7 +1411,7 @@ test cmdAH-29.1 {Tcl_FileObjCmd: type} { test cmdAH-29.2 {Tcl_FileObjCmd: type} { file type $dirfile } directory -test cmdAH-29.3.0 {Tcl_FileObjCmd: delete removes link not file} {unixOnly nonPortable} { +test cmdAH-29.3.0 {Tcl_FileObjCmd: delete removes link not file} {unix nonPortable} { set exists [list [file exists $linkfile] [file exists $gorpfile]] file delete $linkfile set exists2 [list [file exists $linkfile] [file exists $gorpfile]] @@ -1360,7 +1420,7 @@ test cmdAH-29.3.0 {Tcl_FileObjCmd: delete removes link not file} {unixOnly nonPo test cmdAH-29.3 {Tcl_FileObjCmd: type} { file type $gorpfile } file -test cmdAH-29.4 {Tcl_FileObjCmd: type} {unixOnly} { +test cmdAH-29.4 {Tcl_FileObjCmd: type} {unix} { catch {file delete $linkfile} # Unlike [exec ln -s], [file link] requires an existing target file link -symbolic $linkfile $gorpfile @@ -1368,16 +1428,6 @@ test cmdAH-29.4 {Tcl_FileObjCmd: type} {unixOnly} { file delete $linkfile set result } link -if {[string equal $tcl_platform(platform) "windows"]} { - if {[string index $tcl_platform(osVersion) 0] >= 5 \ - && ([lindex [file system [temporaryDirectory]] 1] == "NTFS")} { - tcltest::testConstraint linkDirectory 1 - } else { - tcltest::testConstraint linkDirectory 0 - } -} else { - tcltest::testConstraint linkDirectory 1 -} test cmdAH-29.4.1 {Tcl_FileObjCmd: type} {linkDirectory} { set tempdir [makeDirectory temp] set linkdir [file join [temporaryDirectory] link.dir] @@ -1508,3 +1558,7 @@ cd $cmdAHwd ::tcltest::cleanupTests return + +# Local Variables: +# mode: tcl +# End: |