diff options
Diffstat (limited to 'tests/cmdAH.test')
-rw-r--r-- | tests/cmdAH.test | 1256 |
1 files changed, 1256 insertions, 0 deletions
diff --git a/tests/cmdAH.test b/tests/cmdAH.test new file mode 100644 index 0000000..351008e --- /dev/null +++ b/tests/cmdAH.test @@ -0,0 +1,1256 @@ +# The file tests the tclCmdAH.c file. +# +# This file contains a collection of tests for one or more of the Tcl +# built-in commands. Sourcing this file into Tcl runs the tests and +# generates output for errors. No output means no errors were found. +# +# Copyright (c) 1996-1997 by Sun Microsystems, Inc. +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# SCCS: @(#) cmdAH.test 1.35 97/07/22 14:07:43 + +if {[string compare test [info procs test]] == 1} then {source defs} + +global env +set platform [testgetplatform] + +test cmdAH-1.1 {Tcl_FileObjCmd} { + list [catch file msg] $msg +} {1 {wrong # args: should be "file option ?arg ...?"}} +test cmdAH-1.2 {Tcl_FileObjCmd} { + list [catch {file x} msg] $msg +} {1 {bad option "x": must be atime, attributes, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}} +test cmdAH-1.3 {Tcl_FileObjCmd} { + list [catch {file atime} msg] $msg +} {1 {wrong # args: should be "file atime name ?arg ...?"}} + + +#volume + +test cmdAH-2.1 {Tcl_FileObjCmd: volumes} { + list [catch {file volumes x} msg] $msg +} {1 {wrong # args: should be "file volumes"}} +test cmdAH-2.2 {Tcl_FileObjCmd: volumes} { + set volumeList [file volumes] + if { [llength $volumeList] == 0 } { + set result 0 + } else { + set result 1 + } +} {1} +test cmdAH-2.3 {Tcl_FileObjCmd: volumes} {macOrUnix} { + set volumeList [file volumes] + catch [list glob -nocomplain [lindex $volumeList 0]*] +} {0} +test cmdAH-2.4 {Tcl_FileObjCmd: volumes} {pcOnly} { + set volumeList [file volumes] + list [catch {lsearch $volumeList "c:/"} element] [expr $element != -1] [catch {list glob -nocomplain [lindex $volumeList $element]*}] +} {0 1 0} + +# attributes + +test cmdAH-3.1 {Tcl_FileObjCmd - file attrs} { + catch {file delete -force foo.file} + close [open foo.file w] + list [catch {file attributes foo.file}] [file delete -force foo.file] +} {0 {}} + +# dirname + +test cmdAH-4.1 {Tcl_FileObjCmd: dirname} { + testsetplatform unix + list [catch {file dirname a b} msg] $msg +} {1 {wrong # args: should be "file dirname name"}} +test cmdAH-4.2 {Tcl_FileObjCmd: dirname} { + testsetplatform unix + file dirname /a/b +} /a +test cmdAH-4.3 {Tcl_FileObjCmd: dirname} { + testsetplatform unix + file dirname {} +} . +test cmdAH-4.4 {Tcl_FileObjCmd: dirname} { + testsetplatform mac + file dirname {} +} : +test cmdAH-4.5 {Tcl_FileObjCmd: dirname} { + testsetplatform win + file dirname {} +} . +test cmdAH-4.6 {Tcl_FileObjCmd: dirname} { + testsetplatform unix + file dirname .def +} . +test cmdAH-4.7 {Tcl_FileObjCmd: dirname} { + testsetplatform mac + file dirname a +} : +test cmdAH-4.8 {Tcl_FileObjCmd: dirname} { + testsetplatform win + file dirname a +} . +test cmdAH-4.9 {Tcl_FileObjCmd: dirname} { + testsetplatform unix + file dirname a/b/c.d +} a/b +test cmdAH-4.10 {Tcl_FileObjCmd: dirname} { + testsetplatform unix + file dirname a/b.c/d +} a/b.c +test cmdAH-4.11 {Tcl_FileObjCmd: dirname} { + testsetplatform unix + file dirname /. +} / +test cmdAH-4.12 {Tcl_FileObjCmd: dirname} { + testsetplatform unix + list [catch {file dirname /} msg] $msg +} {0 /} +test cmdAH-4.13 {Tcl_FileObjCmd: dirname} { + testsetplatform unix + list [catch {file dirname /foo} msg] $msg +} {0 /} +test cmdAH-4.14 {Tcl_FileObjCmd: dirname} { + testsetplatform unix + list [catch {file dirname //foo} msg] $msg +} {0 /} +test cmdAH-4.15 {Tcl_FileObjCmd: dirname} { + testsetplatform unix + list [catch {file dirname //foo/bar} msg] $msg +} {0 /foo} +test cmdAH-4.16 {Tcl_FileObjCmd: dirname} { + testsetplatform unix + list [catch {file dirname {//foo\/bar/baz}} msg] $msg +} {0 {/foo\/bar}} +test cmdAH-4.17 {Tcl_FileObjCmd: dirname} { + testsetplatform unix + list [catch {file dirname {//foo\/bar/baz/blat}} msg] $msg +} {0 {/foo\/bar/baz}} +test cmdAH-4.18 {Tcl_FileObjCmd: dirname} { + testsetplatform unix + list [catch {file dirname /foo//} msg] $msg +} {0 /} +test cmdAH-4.19 {Tcl_FileObjCmd: dirname} { + testsetplatform unix + list [catch {file dirname ./a} msg] $msg +} {0 .} +test cmdAH-4.20 {Tcl_FileObjCmd: dirname} { + testsetplatform unix + list [catch {file dirname a/.a} msg] $msg +} {0 a} +test cmdAH-4.21 {Tcl_FileObjCmd: dirname} { + testsetplatform windows + list [catch {file dirname c:foo} msg] $msg +} {0 c:} +test cmdAH-4.22 {Tcl_FileObjCmd: dirname} { + testsetplatform windows + list [catch {file dirname c:} msg] $msg +} {0 c:} +test cmdAH-4.23 {Tcl_FileObjCmd: dirname} { + testsetplatform windows + list [catch {file dirname c:/} msg] $msg +} {0 c:/} +test cmdAH-4.24 {Tcl_FileObjCmd: dirname} { + testsetplatform windows + list [catch {file dirname {c:\foo}} msg] $msg +} {0 c:/} +test cmdAH-4.25 {Tcl_FileObjCmd: dirname} { + testsetplatform windows + list [catch {file dirname {//foo/bar/baz}} msg] $msg +} {0 //foo/bar} +test cmdAH-4.26 {Tcl_FileObjCmd: dirname} { + testsetplatform windows + list [catch {file dirname {//foo/bar}} msg] $msg +} {0 //foo/bar} +test cmdAH-4.27 {Tcl_FileObjCmd: dirname} { + testsetplatform mac + list [catch {file dirname :} msg] $msg +} {0 :} +test cmdAH-4.28 {Tcl_FileObjCmd: dirname} { + testsetplatform mac + list [catch {file dirname :Foo} msg] $msg +} {0 :} +test cmdAH-4.29 {Tcl_FileObjCmd: dirname} { + testsetplatform mac + list [catch {file dirname Foo:} msg] $msg +} {0 Foo:} +test cmdAH-4.30 {Tcl_FileObjCmd: dirname} { + testsetplatform mac + list [catch {file dirname Foo:bar} msg] $msg +} {0 Foo:} +test cmdAH-4.31 {Tcl_FileObjCmd: dirname} { + testsetplatform mac + list [catch {file dirname :Foo:bar} msg] $msg +} {0 :Foo} +test cmdAH-4.32 {Tcl_FileObjCmd: dirname} { + testsetplatform mac + list [catch {file dirname ::} msg] $msg +} {0 :} +test cmdAH-4.33 {Tcl_FileObjCmd: dirname} { + testsetplatform mac + list [catch {file dirname :::} msg] $msg +} {0 ::} +test cmdAH-4.34 {Tcl_FileObjCmd: dirname} { + testsetplatform mac + list [catch {file dirname /foo/bar/} msg] $msg +} {0 foo:} +test cmdAH-4.35 {Tcl_FileObjCmd: dirname} { + testsetplatform mac + list [catch {file dirname /foo/bar} msg] $msg +} {0 foo:} +test cmdAH-4.36 {Tcl_FileObjCmd: dirname} { + testsetplatform mac + list [catch {file dirname /foo} msg] $msg +} {0 foo:} +test cmdAH-4.37 {Tcl_FileObjCmd: dirname} { + testsetplatform mac + list [catch {file dirname foo} msg] $msg +} {0 :} +test cmdAH-4.38 {Tcl_FileObjCmd: dirname} { + testsetplatform unix + list [catch {file dirname ~/foo} msg] $msg +} {0 ~} +test cmdAH-4.39 {Tcl_FileObjCmd: dirname} { + testsetplatform unix + list [catch {file dirname ~bar/foo} msg] $msg +} {0 ~bar} +test cmdAH-4.40 {Tcl_FileObjCmd: dirname} { + testsetplatform mac + list [catch {file dirname ~bar/foo} msg] $msg +} {0 ~bar:} +test cmdAH-4.41 {Tcl_FileObjCmd: dirname} { + testsetplatform mac + list [catch {file dirname ~/foo} msg] $msg +} {0 ~:} +test cmdAH-4.42 {Tcl_FileObjCmd: dirname} { + testsetplatform mac + list [catch {file dirname ~:baz} msg] $msg +} {0 ~:} +test cmdAH-4.43 {Tcl_FileObjCmd: dirname} { + global env + set temp $env(HOME) + set env(HOME) "/home/test" + testsetplatform unix + set result [list [catch {file dirname ~} msg] $msg] + set env(HOME) $temp + set result +} {0 /home} +test cmdAH-4.44 {Tcl_FileObjCmd: dirname} { + global env + set temp $env(HOME) + set env(HOME) "~" + testsetplatform unix + set result [list [catch {file dirname ~} msg] $msg] + set env(HOME) $temp + set result +} {0 ~} +test cmdAH-4.45 {Tcl_FileObjCmd: dirname} { + global env + set temp $env(HOME) + set env(HOME) "/home/test" + testsetplatform windows + set result [list [catch {file dirname ~} msg] $msg] + set env(HOME) $temp + set result +} {0 /home} +test cmdAH-4.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:} + +# tail + +test cmdAH-5.1 {Tcl_FileObjCmd: tail} { + testsetplatform unix + list [catch {file tail a b} msg] $msg +} {1 {wrong # args: should be "file tail name"}} +test cmdAH-5.2 {Tcl_FileObjCmd: tail} { + testsetplatform unix + file tail /a/b +} b +test cmdAH-5.3 {Tcl_FileObjCmd: tail} { + testsetplatform unix + file tail {} +} {} +test cmdAH-5.4 {Tcl_FileObjCmd: tail} { + testsetplatform mac + file tail {} +} {} +test cmdAH-5.5 {Tcl_FileObjCmd: tail} { + testsetplatform win + file tail {} +} {} +test cmdAH-5.6 {Tcl_FileObjCmd: tail} { + testsetplatform unix + file tail .def +} .def +test cmdAH-5.7 {Tcl_FileObjCmd: tail} { + testsetplatform mac + file tail a +} a +test cmdAH-5.8 {Tcl_FileObjCmd: tail} { + testsetplatform win + file tail a +} a +test cmdAH-5.9 {Tcl_FileObjCmd: tail} { + testsetplatform unix + file ta a/b/c.d +} c.d +test cmdAH-5.10 {Tcl_FileObjCmd: tail} { + testsetplatform unix + file tail a/b.c/d +} d +test cmdAH-5.11 {Tcl_FileObjCmd: tail} { + testsetplatform unix + file tail /. +} . +test cmdAH-5.12 {Tcl_FileObjCmd: tail} { + testsetplatform unix + file tail / +} {} +test cmdAH-5.13 {Tcl_FileObjCmd: tail} { + testsetplatform unix + file tail /foo +} foo +test cmdAH-5.14 {Tcl_FileObjCmd: tail} { + testsetplatform unix + file tail //foo +} foo +test cmdAH-5.15 {Tcl_FileObjCmd: tail} { + testsetplatform unix + file tail //foo/bar +} bar +test cmdAH-5.16 {Tcl_FileObjCmd: tail} { + testsetplatform unix + file tail {//foo\/bar/baz} +} baz +test cmdAH-5.17 {Tcl_FileObjCmd: tail} { + testsetplatform unix + file tail {//foo\/bar/baz/blat} +} blat +test cmdAH-5.18 {Tcl_FileObjCmd: tail} { + testsetplatform unix + file tail /foo// +} foo +test cmdAH-5.19 {Tcl_FileObjCmd: tail} { + testsetplatform unix + file tail ./a +} a +test cmdAH-5.20 {Tcl_FileObjCmd: tail} { + testsetplatform unix + file tail a/.a +} .a +test cmdAH-5.21 {Tcl_FileObjCmd: tail} { + testsetplatform windows + file tail c:foo +} foo +test cmdAH-5.22 {Tcl_FileObjCmd: tail} { + testsetplatform windows + file tail c: +} {} +test cmdAH-5.23 {Tcl_FileObjCmd: tail} { + testsetplatform windows + file tail c:/ +} {} +test cmdAH-5.24 {Tcl_FileObjCmd: tail} { + testsetplatform windows + file tail {c:\foo} +} foo +test cmdAH-5.25 {Tcl_FileObjCmd: tail} { + testsetplatform windows + file tail {//foo/bar/baz} +} baz +test cmdAH-5.26 {Tcl_FileObjCmd: tail} { + testsetplatform windows + file tail {//foo/bar} +} {} +test cmdAH-5.27 {Tcl_FileObjCmd: tail} { + testsetplatform mac + file tail : +} : +test cmdAH-5.28 {Tcl_FileObjCmd: tail} { + testsetplatform mac + file tail :Foo +} Foo +test cmdAH-5.29 {Tcl_FileObjCmd: tail} { + testsetplatform mac + file tail Foo: +} {} +test cmdAH-5.30 {Tcl_FileObjCmd: tail} { + testsetplatform mac + file tail Foo:bar +} bar +test cmdAH-5.31 {Tcl_FileObjCmd: tail} { + testsetplatform mac + file tail :Foo:bar +} bar +test cmdAH-5.32 {Tcl_FileObjCmd: tail} { + testsetplatform mac + file tail :: +} :: +test cmdAH-5.33 {Tcl_FileObjCmd: tail} { + testsetplatform mac + file tail ::: +} :: +test cmdAH-5.34 {Tcl_FileObjCmd: tail} { + testsetplatform mac + file tail /foo/bar/ +} bar +test cmdAH-5.35 {Tcl_FileObjCmd: tail} { + testsetplatform mac + file tail /foo/bar +} bar +test cmdAH-5.36 {Tcl_FileObjCmd: tail} { + testsetplatform mac + file tail /foo +} {} +test cmdAH-5.37 {Tcl_FileObjCmd: tail} { + testsetplatform mac + file tail foo +} foo +test cmdAH-5.38 {Tcl_FileObjCmd: tail} { + testsetplatform mac + file tail ~:foo +} foo +test cmdAH-5.39 {Tcl_FileObjCmd: tail} { + testsetplatform mac + file tail ~bar:foo +} foo +test cmdAH-5.40 {Tcl_FileObjCmd: tail} { + testsetplatform mac + file tail ~bar/foo +} foo +test cmdAH-5.41 {Tcl_FileObjCmd: tail} { + testsetplatform mac + file tail ~/foo +} foo +test cmdAH-5.42 {Tcl_FileObjCmd: tail} { + global env + set temp $env(HOME) + set env(HOME) "/home/test" + testsetplatform unix + set result [file tail ~] + set env(HOME) $temp + set result +} test +test cmdAH-5.43 {Tcl_FileObjCmd: tail} { + global env + set temp $env(HOME) + set env(HOME) "~" + testsetplatform unix + set result [file tail ~] + set env(HOME) $temp + set result +} {} +test cmdAH-5.44 {Tcl_FileObjCmd: tail} { + global env + set temp $env(HOME) + set env(HOME) "/home/test" + testsetplatform windows + set result [file tail ~] + set env(HOME) $temp + set result +} test +test cmdAH-5.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-5.46 {Tcl_FileObjCmd: tail} { + testsetplatform unix + file tail {f.oo\bar/baz.bat} +} baz.bat +test cmdAH-5.47 {Tcl_FileObjCmd: tail} { + testsetplatform windows + file tail c:foo +} foo +test cmdAH-5.48 {Tcl_FileObjCmd: tail} { + testsetplatform windows + file tail c: +} {} +test cmdAH-5.49 {Tcl_FileObjCmd: tail} { + testsetplatform windows + file tail c:/foo +} foo +test cmdAH-5.50 {Tcl_FileObjCmd: tail} { + testsetplatform windows + file tail {c:/foo\bar} +} bar +test cmdAH-5.51 {Tcl_FileObjCmd: tail} { + testsetplatform windows + file tail {foo\bar} +} bar + +# rootname + +test cmdAH-6.1 {Tcl_FileObjCmd: rootname} { + testsetplatform unix + list [catch {file rootname a b} msg] $msg +} {1 {wrong # args: should be "file rootname name"}} +test cmdAH-6.2 {Tcl_FileObjCmd: rootname} { + testsetplatform unix + file rootname {} +} {} +test cmdAH-6.3 {Tcl_FileObjCmd: rootname} { + testsetplatform unix + file ro foo +} foo +test cmdAH-6.4 {Tcl_FileObjCmd: rootname} { + testsetplatform unix + file rootname foo. +} foo +test cmdAH-6.5 {Tcl_FileObjCmd: rootname} { + testsetplatform unix + file rootname .foo +} {} +test cmdAH-6.6 {Tcl_FileObjCmd: rootname} { + testsetplatform unix + file rootname abc.def +} abc +test cmdAH-6.7 {Tcl_FileObjCmd: rootname} { + testsetplatform unix + file rootname abc.def.ghi +} abc.def +test cmdAH-6.8 {Tcl_FileObjCmd: rootname} { + testsetplatform unix + file rootname a/b/c.d +} a/b/c +test cmdAH-6.9 {Tcl_FileObjCmd: rootname} { + testsetplatform unix + file rootname a/b.c/d +} a/b.c/d +test cmdAH-6.10 {Tcl_FileObjCmd: rootname} { + testsetplatform unix + file rootname a/b.c/ +} a/b.c/ +test cmdAH-6.11 {Tcl_FileObjCmd: rootname} { + testsetplatform mac + file ro foo +} foo +test cmdAH-6.12 {Tcl_FileObjCmd: rootname} { + testsetplatform mac + file rootname {} +} {} +test cmdAH-6.13 {Tcl_FileObjCmd: rootname} { + testsetplatform mac + file rootname foo. +} foo +test cmdAH-6.14 {Tcl_FileObjCmd: rootname} { + testsetplatform mac + file rootname .foo +} {} +test cmdAH-6.15 {Tcl_FileObjCmd: rootname} { + testsetplatform mac + file rootname abc.def +} abc +test cmdAH-6.16 {Tcl_FileObjCmd: rootname} { + testsetplatform mac + file rootname abc.def.ghi +} abc.def +test cmdAH-6.17 {Tcl_FileObjCmd: rootname} { + testsetplatform mac + file rootname a:b:c.d +} a:b:c +test cmdAH-6.18 {Tcl_FileObjCmd: rootname} { + testsetplatform mac + file rootname a:b.c:d +} a:b.c:d +test cmdAH-6.19 {Tcl_FileObjCmd: rootname} { + testsetplatform mac + file rootname a/b/c.d +} a/b/c +test cmdAH-6.20 {Tcl_FileObjCmd: rootname} { + testsetplatform mac + file rootname a/b.c/d +} a/b.c/d +test cmdAH-6.21 {Tcl_FileObjCmd: rootname} { + testsetplatform mac + file rootname /a.b +} /a +test cmdAH-6.22 {Tcl_FileObjCmd: rootname} { + testsetplatform mac + file rootname foo.c: +} foo.c: +test cmdAH-6.23 {Tcl_FileObjCmd: rootname} { + testsetplatform windows + file rootname {} +} {} +test cmdAH-6.24 {Tcl_FileObjCmd: rootname} { + testsetplatform windows + file ro foo +} foo +test cmdAH-6.25 {Tcl_FileObjCmd: rootname} { + testsetplatform windows + file rootname foo. +} foo +test cmdAH-6.26 {Tcl_FileObjCmd: rootname} { + testsetplatform windows + file rootname .foo +} {} +test cmdAH-6.27 {Tcl_FileObjCmd: rootname} { + testsetplatform windows + file rootname abc.def +} abc +test cmdAH-6.28 {Tcl_FileObjCmd: rootname} { + testsetplatform windows + file rootname abc.def.ghi +} abc.def +test cmdAH-6.29 {Tcl_FileObjCmd: rootname} { + testsetplatform windows + file rootname a/b/c.d +} a/b/c +test cmdAH-6.30 {Tcl_FileObjCmd: rootname} { + testsetplatform windows + file rootname a/b.c/d +} a/b.c/d +test cmdAH-6.31 {Tcl_FileObjCmd: rootname} { + testsetplatform windows + file rootname a\\b.c\\ +} a\\b.c\\ +test cmdAH-6.32 {Tcl_FileObjCmd: rootname} { + testsetplatform windows + file rootname a\\b\\c.d +} a\\b\\c +test cmdAH-6.33 {Tcl_FileObjCmd: rootname} { + testsetplatform windows + file rootname a\\b.c\\d +} a\\b.c\\d +test cmdAH-6.34 {Tcl_FileObjCmd: rootname} { + 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] + } +} + +# extension + +test cmdAH-7.1 {Tcl_FileObjCmd: extension} { + testsetplatform unix + list [catch {file extension a b} msg] $msg +} {1 {wrong # args: should be "file extension name"}} +test cmdAH-7.2 {Tcl_FileObjCmd: extension} { + testsetplatform unix + file extension {} +} {} +test cmdAH-7.3 {Tcl_FileObjCmd: extension} { + testsetplatform unix + file ext foo +} {} +test cmdAH-7.4 {Tcl_FileObjCmd: extension} { + testsetplatform unix + file extension foo. +} . +test cmdAH-7.5 {Tcl_FileObjCmd: extension} { + testsetplatform unix + file extension .foo +} .foo +test cmdAH-7.6 {Tcl_FileObjCmd: extension} { + testsetplatform unix + file extension abc.def +} .def +test cmdAH-7.7 {Tcl_FileObjCmd: extension} { + testsetplatform unix + file extension abc.def.ghi +} .ghi +test cmdAH-7.8 {Tcl_FileObjCmd: extension} { + testsetplatform unix + file extension a/b/c.d +} .d +test cmdAH-7.9 {Tcl_FileObjCmd: extension} { + testsetplatform unix + file extension a/b.c/d +} {} +test cmdAH-7.10 {Tcl_FileObjCmd: extension} { + testsetplatform unix + file extension a/b.c/ +} {} +test cmdAH-7.11 {Tcl_FileObjCmd: extension} { + testsetplatform mac + file ext foo +} {} +test cmdAH-7.12 {Tcl_FileObjCmd: extension} { + testsetplatform mac + file extension {} +} {} +test cmdAH-7.13 {Tcl_FileObjCmd: extension} { + testsetplatform mac + file extension foo. +} . +test cmdAH-7.14 {Tcl_FileObjCmd: extension} { + testsetplatform mac + file extension .foo +} .foo +test cmdAH-7.15 {Tcl_FileObjCmd: extension} { + testsetplatform mac + file extension abc.def +} .def +test cmdAH-7.16 {Tcl_FileObjCmd: extension} { + testsetplatform mac + file extension abc.def.ghi +} .ghi +test cmdAH-7.17 {Tcl_FileObjCmd: extension} { + testsetplatform mac + file extension a:b:c.d +} .d +test cmdAH-7.18 {Tcl_FileObjCmd: extension} { + testsetplatform mac + file extension a:b.c:d +} {} +test cmdAH-7.19 {Tcl_FileObjCmd: extension} { + testsetplatform mac + file extension a/b/c.d +} .d +test cmdAH-7.20 {Tcl_FileObjCmd: extension} { + testsetplatform mac + file extension a/b.c/d +} {} +test cmdAH-7.21 {Tcl_FileObjCmd: extension} { + testsetplatform mac + file extension /a.b +} .b +test cmdAH-7.22 {Tcl_FileObjCmd: extension} { + testsetplatform mac + file extension foo.c: +} {} +test cmdAH-7.23 {Tcl_FileObjCmd: extension} { + testsetplatform windows + file extension {} +} {} +test cmdAH-7.24 {Tcl_FileObjCmd: extension} { + testsetplatform windows + file ext foo +} {} +test cmdAH-7.25 {Tcl_FileObjCmd: extension} { + testsetplatform windows + file extension foo. +} . +test cmdAH-7.26 {Tcl_FileObjCmd: extension} { + testsetplatform windows + file extension .foo +} .foo +test cmdAH-7.27 {Tcl_FileObjCmd: extension} { + testsetplatform windows + file extension abc.def +} .def +test cmdAH-7.28 {Tcl_FileObjCmd: extension} { + testsetplatform windows + file extension abc.def.ghi +} .ghi +test cmdAH-7.29 {Tcl_FileObjCmd: extension} { + testsetplatform windows + file extension a/b/c.d +} .d +test cmdAH-7.30 {Tcl_FileObjCmd: extension} { + testsetplatform windows + file extension a/b.c/d +} {} +test cmdAH-7.31 {Tcl_FileObjCmd: extension} { + testsetplatform windows + file extension a\\b.c\\ +} {} +test cmdAH-7.32 {Tcl_FileObjCmd: extension} { + testsetplatform windows + file extension a\\b\\c.d +} .d +test cmdAH-7.33 {Tcl_FileObjCmd: extension} { + testsetplatform windows + file extension a\\b.c\\d +} {} +test cmdAH-7.34 {Tcl_FileObjCmd: extension} { + 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} " + testsetplatform $p + file extension $value + " $result + incr num + } +} + +# pathtype + +test cmdAH-8.1 {Tcl_FileObjCmd: pathtype} { + testsetplatform unix + list [catch {file pathtype a b} msg] $msg +} {1 {wrong # args: should be "file pathtype name"}} +test cmdAH-8.2 {Tcl_FileObjCmd: pathtype} { + testsetplatform unix + file pathtype /a +} absolute +test cmdAH-8.3 {Tcl_FileObjCmd: pathtype} { + testsetplatform unix + file p a +} relative +test cmdAH-8.4 {Tcl_FileObjCmd: pathtype} { + testsetplatform windows + file pathtype c:a +} volumerelative + +# split + +test cmdAH-9.1 {Tcl_FileObjCmd: split} { + testsetplatform unix + list [catch {file split a b} msg] $msg +} {1 {wrong # args: should be "file split name"}} +test cmdAH-9.2 {Tcl_FileObjCmd: split} { + testsetplatform unix + file split a +} a +test cmdAH-9.3 {Tcl_FileObjCmd: split} { + testsetplatform unix + file split a/b +} {a b} + +# join + +test cmdAH-10.1 {Tcl_FileObjCmd: join} { + testsetplatform unix + file join a +} a +test cmdAH-10.2 {Tcl_FileObjCmd: join} { + testsetplatform unix + file join a b +} a/b +test cmdAH-10.3 {Tcl_FileObjCmd: join} { + testsetplatform unix + file join a b c d +} a/b/c/d + +# error handling of Tcl_TranslateFileName + +test cmdAH-11.1 {Tcl_FileObjCmd} { + testsetplatform unix + list [catch {file atime ~_bad_user} msg] $msg +} {1 {user "_bad_user" doesn't exist}} + +testsetplatform $platform +makeFile abcde gorp.file +makeDirectory dir.file + +# readable + +test cmdAH-12.1 {Tcl_FileObjCmd: readable} { + list [catch {file readable a b} msg] $msg +} {1 {wrong # args: should be "file readable name"}} +testchmod 444 gorp.file +test cmdAH-12.2 {Tcl_FileObjCmd: readable} { + file readable gorp.file +} 1 +testchmod 333 gorp.file +test cmdAH-12.3 {Tcl_FileObjCmd: readable} {unixOnly && !root} { + file reada gorp.file +} 0 + +# writable + +test cmdAH-13.1 {Tcl_FileObjCmd: writable} { + list [catch {file writable a b} msg] $msg +} {1 {wrong # args: should be "file writable name"}} +testchmod 555 gorp.file +test cmdAH-13.2 {Tcl_FileObjCmd: writable} {!root} { + file writable gorp.file +} 0 +testchmod 222 gorp.file +test cmdAH-13.3 {Tcl_FileObjCmd: writable} { + file writable gorp.file +} 1 + +# executable + +file delete -force dir.file gorp.file +file mkdir dir.file +makeFile abcde gorp.file + +test cmdAH-14.1 {Tcl_FileObjCmd: executable} { + list [catch {file executable a b} msg] $msg +} {1 {wrong # args: should be "file executable name"}} +test cmdAH-14.2 {Tcl_FileObjCmd: executable} { + file executable gorp.file +} 0 +test cmdAH-14.3 {Tcl_FileObjCmd: executable} {unix} { + # Only on unix will setting the execute bit on a regular file + # cause that file to be executable. + + testchmod 775 gorp.file + file exe gorp.file +} 1 + +test cmdAH-14.4 {Tcl_FileObjCmd: executable} {mac} { + # On mac, the only executable files are of type APPL. + + set x [file exe gorp.file] + file attrib gorp.file -type APPL + lappend x [file exe gorp.file] +} {0 1} +test cmdAH-14.5 {Tcl_FileObjCmd: executable} {pc} { + # On pc, must be a .exe, .com, etc. + + set x [file exe gorp.file] + makeFile foo gorp.exe + lappend x [file exe gorp.exe] + file delete gorp.exe + set x +} {0 1} +test cmdAH-14.6 {Tcl_FileObjCmd: executable} { + # Directories are always executable. + + file exe dir.file +} 1 + +file delete -force dir.file +file delete gorp.file +file delete link.file +# exists + +test cmdAH-15.1 {Tcl_FileObjCmd: exists} { + list [catch {file exists a b} msg] $msg +} {1 {wrong # args: should be "file exists name"}} +test cmdAH-15.2 {Tcl_FileObjCmd: exists} {file exists gorp.file} 0 +test cmdAH-15.3 {Tcl_FileObjCmd: exists} { + file exists [file join dir.file gorp.file] +} 0 +catch { + makeFile abcde gorp.file + makeDirectory dir.file + makeFile 12345 [file join dir.file gorp.file] +} +test cmdAH-15.4 {Tcl_FileObjCmd: exists} { + file exists gorp.file +} 1 +test cmdAH-15.5 {Tcl_FileObjCmd: exists} { + file exists [file join dir.file gorp.file] +} 1 + +# nativename +test cmdAH-15.6 {Tcl_FileObjCmd: nativename} { + testsetplatform unix + list [catch {file nativename a/b} msg] $msg [testsetplatform $platform] +} {0 a/b {}} +test cmdAH-15.7 {Tcl_FileObjCmd: nativename} { + testsetplatform windows + list [catch {file nativename a/b} msg] $msg [testsetplatform $platform] +} {0 {a\b} {}} +test cmdAH-15.8 {Tcl_FileObjCmd: nativename} { + testsetplatform mac + list [catch {file nativename a/b} msg] $msg [testsetplatform $platform] +} {0 :a:b {}} + +test cmdAH-15.9 {Tcl_FileObjCmd: ~ : exists} { + file exists ~nOsUcHuSeR +} 0 +test cmdAH-15.10 {Tcl_FileObjCmd: ~ : nativename} { + # should probably be 0 in fact... + catch {file nativename ~nOsUcHuSeR} +} 1 + +# The test below has to be done in /tmp rather than the current +# directory in order to guarantee (?) a local file system: some +# NFS file systems won't do the stuff below correctly. + +if {$tcl_platform(platform) == "unix"} { + file delete /tmp/tcl.foo.dir/file + removeDirectory /tmp/tcl.foo.dir + makeDirectory /tmp/tcl.foo.dir + makeFile 12345 /tmp/tcl.foo.dir/file + exec chmod 000 /tmp/tcl.foo.dir + if {$user != "root"} { + test cmdAH-15.9 {Tcl_FileObjCmd: exists} { + file exists /tmp/tcl.foo.dir/file + } 0 + } + exec chmod 775 /tmp/tcl.foo.dir + file delete /tmp/tcl.foo.dir/file + removeDirectory /tmp/tcl.foo.dir +} + +# Stat related commands + +testsetplatform $platform +file delete gorp.file +makeFile "Test string" gorp.file +catch {exec chmod 765 gorp.file} + +# atime + +test cmdAH-16.1 {Tcl_FileObjCmd: atime} { + list [catch {file atime a b} msg] $msg +} {1 {wrong # args: should be "file atime name"}} +test cmdAH-16.2 {Tcl_FileObjCmd: atime} { + catch {unset stat} + file stat gorp.file stat + list [expr {[file mtime gorp.file] == $stat(mtime)}] \ + [expr {[file atime gorp.file] == $stat(atime)}] +} {1 1} +test cmdAH-16.3 {Tcl_FileObjCmd: atime} { + string tolower [list [catch {file atime _bogus_} msg] \ + $msg $errorCode] +} {1 {couldn't stat "_bogus_": no such file or directory} {posix enoent {no such file or directory}}} + +# isdirectory + +test cmdAH-17.1 {Tcl_FileObjCmd: isdirectory} { + list [catch {file isdirectory a b} msg] $msg +} {1 {wrong # args: should be "file isdirectory name"}} +test cmdAH-17.2 {Tcl_FileObjCmd: isdirectory} { + file isdirectory gorp.file +} 0 +test cmdAH-17.3 {Tcl_FileObjCmd: isdirectory} { + file isd dir.file +} 1 + +# isfile + +test cmdAH-18.1 {Tcl_FileObjCmd: isfile} { + list [catch {file isfile a b} msg] $msg +} {1 {wrong # args: should be "file isfile name"}} +test cmdAH-18.2 {Tcl_FileObjCmd: isfile} {file isfile gorp.file} 1 +test cmdAH-18.3 {Tcl_FileObjCmd: isfile} {file isfile dir.file} 0 + +# lstat and readlink: don't run these tests everywhere, since not all +# sites will have symbolic links + +catch {exec ln -s gorp.file link.file} +test cmdAH-19.1 {Tcl_FileObjCmd: lstat} { + list [catch {file lstat a} msg] $msg +} {1 {wrong # args: should be "file lstat name varName"}} +test cmdAH-19.2 {Tcl_FileObjCmd: lstat} { + list [catch {file lstat a b c} msg] $msg +} {1 {wrong # args: should be "file lstat name varName"}} +test cmdAH-19.3 {Tcl_FileObjCmd: lstat} {unixOnly nonPortable} { + catch {unset stat} + file lstat link.file stat + lsort [array names stat] +} {atime ctime dev gid ino mode mtime nlink size type uid} +test cmdAH-19.4 {Tcl_FileObjCmd: lstat} {unixOnly nonPortable} { + catch {unset stat} + file lstat link.file stat + list $stat(nlink) [expr $stat(mode)&0777] $stat(type) +} {1 511 link} +test cmdAH-19.5 {Tcl_FileObjCmd: lstat errors} {nonPortable} { + string tolower [list [catch {file lstat _bogus_ stat} msg] \ + $msg $errorCode] +} {1 {couldn't lstat "_bogus_": no such file or directory} {posix enoent {no such file or directory}}} +test cmdAH-19.6 {Tcl_FileObjCmd: lstat errors} { + catch {unset x} + set x 44 + list [catch {file lstat gorp.file x} msg] $msg $errorCode +} {1 {can't set "x(dev)": variable isn't array} NONE} +catch {unset stat} + +# mtime + +test cmdAH-20.1 {Tcl_FileObjCmd: mtime} { + list [catch {file mtime a b} msg] $msg +} {1 {wrong # args: should be "file mtime name"}} +test cmdAH-20.2 {Tcl_FileObjCmd: mtime} { + set old [file mtime gorp.file] + after 2000 + set f [open gorp.file w] + puts $f "More text" + close $f + set new [file mtime gorp.file] + expr {($new > $old) && ($new <= ($old+5))} +} {1} +test cmdAH-20.3 {Tcl_FileObjCmd: mtime} { + catch {unset stat} + file stat gorp.file stat + list [expr {[file mtime gorp.file] == $stat(mtime)}] \ + [expr {[file atime gorp.file] == $stat(atime)}] +} {1 1} +test cmdAH-20.4 {Tcl_FileObjCmd: mtime} { + string tolower [list [catch {file mtime _bogus_} msg] $msg \ + $errorCode] +} {1 {couldn't stat "_bogus_": no such file or directory} {posix enoent {no such file or directory}}} +test cmdAH-20.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 {$tcl_platform(platform) == "unix"} { + set name /tmp/tcl.test + } else { + set name tf + } + + # Borland file times were off by timezone. 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] + file delete $name + set a +} {1} + + +# owned + +test cmdAH-21.1 {Tcl_FileObjCmd: owned} { + list [catch {file owned a b} msg] $msg +} {1 {wrong # args: should be "file owned name"}} +test cmdAH-21.2 {Tcl_FileObjCmd: owned} { + file owned gorp.file +} 1 +test cmdAH-21.3 {Tcl_FileObjCmd: owned} {unixOnly && !root} { + file owned / +} 0 + +# readlink + +test cmdAH-22.1 {Tcl_FileObjCmd: readlink} { + list [catch {file readlink a b} msg] $msg +} {1 {wrong # args: should be "file readlink name"}} +test cmdAH-22.2 {Tcl_FileObjCmd: readlink} {unixOnly nonPortable} { + file readlink link.file +} gorp.file +test cmdAH-22.3 {Tcl_FileObjCmd: readlink errors} {unixOnly nonPortable} { + list [catch {file readlink _bogus_} msg] [string tolower $msg] \ + [string tolower $errorCode] +} {1 {couldn't readlink "_bogus_": no such file or directory} {posix enoent {no such file or directory}}} +test cmdAH-22.4 {Tcl_FileObjCmd: readlink errors} {macOnly nonPortable} { + list [catch {file readlink _bogus_} msg] [string tolower $msg] \ + [string tolower $errorCode] +} {1 {couldn't readlink "_bogus_": no such file or directory} {posix enoent {no such file or directory}}} +test cmdAH-22.5 {Tcl_FileObjCmd: readlink errors} {pcOnly nonPortable} { + list [catch {file readlink _bogus_} msg] [string tolower $msg] \ + [string tolower $errorCode] +} {1 {couldn't readlink "_bogus_": invalid argument} {posix einval {invalid argument}}} + +# size + +test cmdAH-23.1 {Tcl_FileObjCmd: size} { + list [catch {file size a b} msg] $msg +} {1 {wrong # args: should be "file size name"}} +test cmdAH-23.2 {Tcl_FileObjCmd: size} { + set oldsize [file size gorp.file] + set f [open gorp.file a] + fconfigure $f -translation lf -eofchar {} + puts $f "More text" + close $f + expr {[file size gorp.file] - $oldsize} +} {10} +test cmdAH-23.3 {Tcl_FileObjCmd: size} { + string tolower [list [catch {file size _bogus_} msg] $msg \ + $errorCode] +} {1 {couldn't stat "_bogus_": no such file or directory} {posix enoent {no such file or directory}}} + +# stat + +testsetplatform $platform +makeFile "Test string" gorp.file +catch {exec chmod 765 gorp.file} + +test cmdAH-24.1 {Tcl_FileObjCmd: stat} { + list [catch {file stat _bogus_} msg] $msg $errorCode +} {1 {wrong # args: should be "file stat name varName"} NONE} +test cmdAH-24.2 {Tcl_FileObjCmd: stat} { + list [catch {file stat _bogus_ a b} msg] $msg $errorCode +} {1 {wrong # args: should be "file stat name varName"} NONE} +test cmdAH-24.3 {Tcl_FileObjCmd: stat} { + catch {unset stat} + file stat gorp.file stat + lsort [array names stat] +} {atime ctime dev gid ino mode mtime nlink size type uid} +test cmdAH-24.4 {Tcl_FileObjCmd: stat} { + catch {unset stat} + file stat gorp.file stat + list $stat(nlink) $stat(size) $stat(type) +} {1 12 file} +test cmdAH-24.5 {Tcl_FileObjCmd: stat} {unix} { + catch {unset stat} + file stat gorp.file stat + expr $stat(mode)&0777 +} {501} +test cmdAH-24.6 {Tcl_FileObjCmd: stat} { + string tolower [list [catch {file stat _bogus_ stat} msg] \ + $msg $errorCode] +} {1 {couldn't stat "_bogus_": no such file or directory} {posix enoent {no such file or directory}}} +test cmdAH-24.7 {Tcl_FileObjCmd: stat} { + catch {unset x} + set x 44 + list [catch {file stat gorp.file x} msg] $msg $errorCode +} {1 {can't set "x(dev)": variable isn't array} NONE} +catch {unset stat} + +# type + +file delete link.file + +test cmdAH-25.1 {Tcl_FileObjCmd: type} { + list [catch {file size a b} msg] $msg +} {1 {wrong # args: should be "file size name"}} +test cmdAH-25.2 {Tcl_FileObjCmd: type} { + file type dir.file +} directory +test cmdAH-25.3 {Tcl_FileObjCmd: type} { + file type gorp.file +} file +test cmdAH-25.4 {Tcl_FileObjCmd: type} {unixOnly nonPortable} { + exec ln -s a/b/c link.file + set result [file type link.file] + file delete link.file + set result +} link +test cmdAH-25.5 {Tcl_FileObjCmd: type} { + string tolower [list [catch {file type _bogus_} msg] $msg $errorCode] +} {1 {couldn't stat "_bogus_": no such file or directory} {posix enoent {no such file or directory}}} + +# Error conditions + +test cmdAH-26.1 {error conditions} { + list [catch {file gorp x} msg] $msg +} {1 {bad option "gorp": must be atime, attributes, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}} +test cmdAH-26.2 {error conditions} { + list [catch {file ex x} msg] $msg +} {1 {ambiguous option "ex": must be atime, attributes, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}} +test cmdAH-26.3 {error conditions} { + list [catch {file is x} msg] $msg +} {1 {ambiguous option "is": must be atime, attributes, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}} +test cmdAH-26.4 {error conditions} { + list [catch {file z x} msg] $msg +} {1 {bad option "z": must be atime, attributes, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}} +test cmdAH-26.5 {error conditions} { + list [catch {file read x} msg] $msg +} {1 {ambiguous option "read": must be atime, attributes, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}} +test cmdAH-26.6 {error conditions} { + list [catch {file s x} msg] $msg +} {1 {ambiguous option "s": must be atime, attributes, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}} +test cmdAH-26.7 {error conditions} { + list [catch {file t x} msg] $msg +} {1 {ambiguous option "t": must be atime, attributes, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}} +test cmdAH-26.8 {error conditions} { + list [catch {file dirname ~woohgy} msg] $msg +} {1 {user "woohgy" doesn't exist}} + +testsetplatform $platform +catch {unset platform} + +catch {exec chmod 777 dir.file} +file delete -force dir.file +file delete gorp.file +file delete link.file + +concat "" |