diff options
Diffstat (limited to 'tests/cmdAH.test')
| -rw-r--r-- | tests/cmdAH.test | 809 |
1 files changed, 298 insertions, 511 deletions
diff --git a/tests/cmdAH.test b/tests/cmdAH.test index eb7d96a..2e94d7d 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,13 @@ 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-2.1 {Tcl_CdObjCmd} { list [catch {cd foo bar} msg] $msg @@ -110,7 +120,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 +201,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,179 +232,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.4 {Tcl_FileObjCmd: dirname} { - testsetplatform mac - 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.7 {Tcl_FileObjCmd: dirname} { - testsetplatform mac - file dirname a -} : -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.27 {Tcl_FileObjCmd: dirname} { - testsetplatform mac - list [catch {file dirname :} msg] $msg -} {0 :} -test cmdAH-8.28 {Tcl_FileObjCmd: dirname} { - testsetplatform mac - list [catch {file dirname :Foo} msg] $msg -} {0 :} -test cmdAH-8.29 {Tcl_FileObjCmd: dirname} { - testsetplatform mac - list [catch {file dirname Foo:} msg] $msg -} {0 Foo:} -test cmdAH-8.30 {Tcl_FileObjCmd: dirname} { - testsetplatform mac - list [catch {file dirname Foo:bar} msg] $msg -} {0 Foo:} -test cmdAH-8.31 {Tcl_FileObjCmd: dirname} { - testsetplatform mac - list [catch {file dirname :Foo:bar} msg] $msg -} {0 :Foo} -test cmdAH-8.32 {Tcl_FileObjCmd: dirname} { - testsetplatform mac - list [catch {file dirname ::} msg] $msg -} {0 :} -test cmdAH-8.33 {Tcl_FileObjCmd: dirname} { - testsetplatform mac - list [catch {file dirname :::} msg] $msg -} {0 ::} -test cmdAH-8.34 {Tcl_FileObjCmd: dirname} { - testsetplatform mac - list [catch {file dirname /foo/bar/} msg] $msg -} {0 foo:} -test cmdAH-8.35 {Tcl_FileObjCmd: dirname} { - testsetplatform mac - list [catch {file dirname /foo/bar} msg] $msg -} {0 foo:} -test cmdAH-8.36 {Tcl_FileObjCmd: dirname} { - testsetplatform mac - list [catch {file dirname /foo} msg] $msg -} {0 foo:} -test cmdAH-8.37 {Tcl_FileObjCmd: dirname} { - testsetplatform mac - list [catch {file dirname foo} msg] $msg -} {0 :} -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.40 {Tcl_FileObjCmd: dirname} { - testsetplatform mac - list [catch {file dirname ~bar/foo} msg] $msg -} {0 ~bar:} -test cmdAH-8.41 {Tcl_FileObjCmd: dirname} { - testsetplatform mac - list [catch {file dirname ~/foo} msg] $msg -} {0 ~:} -test cmdAH-8.42 {Tcl_FileObjCmd: dirname} { - testsetplatform mac - list [catch {file dirname ~:baz} msg] $msg -} {0 ~:} -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" @@ -403,7 +345,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) "~" @@ -413,191 +355,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} { - global env - set temp $env(HOME) - set env(HOME) "/home/test" - testsetplatform mac - set result [list [catch {file dirname ~} msg] $msg] - set env(HOME) $temp - set result -} {0 home:} + 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.4 {Tcl_FileObjCmd: tail} { - testsetplatform mac - 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.7 {Tcl_FileObjCmd: tail} { - testsetplatform mac - file tail a -} a -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.27 {Tcl_FileObjCmd: tail} { - testsetplatform mac - file tail : -} : -test cmdAH-9.28 {Tcl_FileObjCmd: tail} { - testsetplatform mac - file tail :Foo -} Foo -test cmdAH-9.29 {Tcl_FileObjCmd: tail} { - testsetplatform mac - file tail Foo: -} {} -test cmdAH-9.30 {Tcl_FileObjCmd: tail} { - testsetplatform mac - file tail Foo:bar -} bar -test cmdAH-9.31 {Tcl_FileObjCmd: tail} { - testsetplatform mac - file tail :Foo:bar -} bar -test cmdAH-9.32 {Tcl_FileObjCmd: tail} { - testsetplatform mac - file tail :: -} :: -test cmdAH-9.33 {Tcl_FileObjCmd: tail} { - testsetplatform mac - file tail ::: -} :: -test cmdAH-9.34 {Tcl_FileObjCmd: tail} { - testsetplatform mac - file tail /foo/bar/ -} bar -test cmdAH-9.35 {Tcl_FileObjCmd: tail} { - testsetplatform mac - file tail /foo/bar -} bar -test cmdAH-9.36 {Tcl_FileObjCmd: tail} { - testsetplatform mac - file tail /foo -} {} -test cmdAH-9.37 {Tcl_FileObjCmd: tail} { - testsetplatform mac - file tail foo -} foo -test cmdAH-9.38 {Tcl_FileObjCmd: tail} { - testsetplatform mac - file tail ~:foo -} foo -test cmdAH-9.39 {Tcl_FileObjCmd: tail} { - testsetplatform mac - file tail ~bar:foo -} foo -test cmdAH-9.40 {Tcl_FileObjCmd: tail} { - testsetplatform mac - file tail ~bar/foo -} foo -test cmdAH-9.41 {Tcl_FileObjCmd: tail} { - testsetplatform mac - file tail ~/foo -} foo -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" @@ -606,7 +490,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) "~" @@ -615,7 +499,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" @@ -624,332 +508,227 @@ test cmdAH-9.44 {Tcl_FileObjCmd: tail} { set env(HOME) $temp set result } test -test cmdAH-9.45 {Tcl_FileObjCmd: tail} { - global env - set temp $env(HOME) - set env(HOME) "/home/test" - testsetplatform mac - set result [file 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.11 {Tcl_FileObjCmd: rootname} { - testsetplatform mac - file ro foo -} foo -test cmdAH-10.12 {Tcl_FileObjCmd: rootname} { - testsetplatform mac - file rootname {} -} {} -test cmdAH-10.13 {Tcl_FileObjCmd: rootname} { - testsetplatform mac - file rootname foo. -} foo -test cmdAH-10.14 {Tcl_FileObjCmd: rootname} { - testsetplatform mac - file rootname .foo -} {} -test cmdAH-10.15 {Tcl_FileObjCmd: rootname} { - testsetplatform mac - file rootname abc.def -} abc -test cmdAH-10.16 {Tcl_FileObjCmd: rootname} { - testsetplatform mac - file rootname abc.def.ghi -} abc.def -test cmdAH-10.17 {Tcl_FileObjCmd: rootname} { - testsetplatform mac - file rootname a:b:c.d -} a:b:c -test cmdAH-10.18 {Tcl_FileObjCmd: rootname} { - testsetplatform mac - file rootname a:b.c:d -} a:b.c:d -test cmdAH-10.19 {Tcl_FileObjCmd: rootname} { - testsetplatform mac - file rootname a/b/c.d -} a/b/c -test cmdAH-10.20 {Tcl_FileObjCmd: rootname} { - testsetplatform mac - file rootname a/b.c/d -} a/b.c/d -test cmdAH-10.21 {Tcl_FileObjCmd: rootname} { - testsetplatform mac - file rootname /a.b -} /a -test cmdAH-10.22 {Tcl_FileObjCmd: rootname} { - testsetplatform mac - file rootname foo.c: -} foo.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.11 {Tcl_FileObjCmd: extension} { - testsetplatform mac - file ext foo -} {} -test cmdAH-11.12 {Tcl_FileObjCmd: extension} { - testsetplatform mac - file extension {} -} {} -test cmdAH-11.13 {Tcl_FileObjCmd: extension} { - testsetplatform mac - file extension foo. -} . -test cmdAH-11.14 {Tcl_FileObjCmd: extension} { - testsetplatform mac - file extension .foo -} .foo -test cmdAH-11.15 {Tcl_FileObjCmd: extension} { - testsetplatform mac - file extension abc.def -} .def -test cmdAH-11.16 {Tcl_FileObjCmd: extension} { - testsetplatform mac - file extension abc.def.ghi -} .ghi -test cmdAH-11.17 {Tcl_FileObjCmd: extension} { - testsetplatform mac - file extension a:b:c.d -} .d -test cmdAH-11.18 {Tcl_FileObjCmd: extension} { - testsetplatform mac - file extension a:b.c:d -} {} -test cmdAH-11.19 {Tcl_FileObjCmd: extension} { - testsetplatform mac - file extension a/b/c.d -} .d -test cmdAH-11.20 {Tcl_FileObjCmd: extension} { - testsetplatform mac - file extension a/b.c/d -} {} -test cmdAH-11.21 {Tcl_FileObjCmd: extension} { - testsetplatform mac - file extension /a.b -} .b -test cmdAH-11.22 {Tcl_FileObjCmd: extension} { - testsetplatform mac - file extension foo.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 mac windows} { -; test cmdAH-7.$num {Tcl_FileObjCmd: extension} " + foreach p {unix windows} { + ;test cmdAH-11.$num {Tcl_FileObjCmd: extension} testsetplatform " testsetplatform $p file extension $value " $result @@ -959,99 +738,104 @@ 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 removeFile $gorpfile @@ -1059,13 +843,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. @@ -1073,23 +857,25 @@ test cmdAH-18.3 {Tcl_FileObjCmd: executable} {unixOnly testchmod} { file exe $gorpfile } 1 -test cmdAH-18.4 {Tcl_FileObjCmd: executable} {macOnly testchmod} { - # On mac, the only executable files are of type APPL. +test cmdAH-18.5 {Tcl_FileObjCmd: executable} {win} { + # On pc, must be a .exe, .com, etc. set x [file exe $gorpfile] - file attrib $gorpfile -type APPL - lappend x [file exe $gorpfile] + set gorpexe [makeFile foo gorp.exe] + lappend x [file exe $gorpexe] + removeFile $gorpexe + set x } {0 1} -test cmdAH-18.5 {Tcl_FileObjCmd: executable} {winOnly 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 $gorpexe] + lappend x [file exe [string toupper $gorpexe]] removeFile $gorpexe set x } {0 1} -test cmdAH-18.6 {Tcl_FileObjCmd: executable} {testchmod} { +test cmdAH-18.6 {Tcl_FileObjCmd: executable} {} { # Directories are always executable. file exe $dirfile @@ -1122,23 +908,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.8 {Tcl_FileObjCmd: nativename} { - testsetplatform mac - list [catch {file nativename a/b} msg] $msg [testsetplatform $platform] -} {0 :a:b {}} -} test cmdAH-19.9 {Tcl_FileObjCmd: ~ : exists} { file exists ~nOsUcHuSeR @@ -1152,7 +929,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 @@ -1176,7 +953,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 @@ -1194,18 +976,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] @@ -1213,7 +1000,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} { @@ -1244,12 +1036,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) @@ -1308,17 +1100,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] @@ -1365,16 +1159,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] @@ -1384,14 +1175,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 @@ -1407,7 +1198,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 @@ -1415,7 +1206,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. @@ -1434,10 +1225,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"] @@ -1446,31 +1235,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 @@ -1479,18 +1274,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.4 {Tcl_FileObjCmd: readlink errors} {macOnly nonPortable} { - list [catch {file readlink _bogus_} msg] [string tolower $msg] \ - [string tolower $errorCode] -} {1 {could not readlink "_bogus_": no such file or directory} {posix enoent {no such file or directory}}} -test cmdAH-26.5 {Tcl_FileObjCmd: readlink errors} {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}}} @@ -1528,7 +1319,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} { @@ -1536,10 +1329,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] \ @@ -1559,7 +1352,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. @@ -1575,7 +1368,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. @@ -1583,7 +1376,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] @@ -1612,7 +1405,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]] @@ -1621,7 +1414,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 @@ -1629,16 +1422,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] @@ -1769,3 +1552,7 @@ cd $cmdAHwd ::tcltest::cleanupTests return + +# Local Variables: +# mode: tcl +# End: |