summaryrefslogtreecommitdiffstats
path: root/tests/cmdAH.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/cmdAH.test')
-rw-r--r--tests/cmdAH.test558
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: