# 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 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.9 96/07/01 14:38:19 if {[string compare test [info procs test]] == 1} then {source defs} global env set platform [testgetplatform] test cmdah-1.1 {Tcl_FileCmd} { list [catch file msg] $msg } {1 {wrong # args: should be "file option name ?arg ...?"}} test cmdah-1.2 {Tcl_FileCmd} { list [catch {file x} msg] $msg } {1 {wrong # args: should be "file option name ?arg ...?"}} # dirname test cmdah-2.1 {Tcl_FileCmd: dirname} { testsetplatform unix list [catch {file dirname a b} msg] $msg } {1 {wrong # args: should be "file dirname name"}} test cmdah-2.2 {Tcl_FileCmd: dirname} { testsetplatform unix file dirname /a/b } /a test cmdah-2.3 {Tcl_FileCmd: dirname} { testsetplatform unix file dirname {} } . test cmdah-2.4 {Tcl_FileCmd: dirname} { testsetplatform mac file dirname {} } : test cmdah-2.5 {Tcl_FileCmd: dirname} { testsetplatform win file dirname {} } . test cmdah-2.6 {Tcl_FileCmd: dirname} { testsetplatform unix file dirname .def } . test cmdah-2.7 {Tcl_FileCmd: dirname} { testsetplatform mac file dirname a } : test cmdah-2.8 {Tcl_FileCmd: dirname} { testsetplatform win file dirname a } . test cmdah-2.9 {Tcl_FileCmd: dirname} { testsetplatform unix file d a/b/c.d } a/b test cmdah-2.10 {Tcl_FileCmd: dirname} { testsetplatform unix file dirname a/b.c/d } a/b.c test cmdah-2.11 {Tcl_FileCmd: dirname} { testsetplatform unix file dirname /. } / test cmdah-2.12 {Tcl_FileCmd: dirname} { testsetplatform unix list [catch {file dirname /} msg] $msg } {0 /} test cmdah-2.13 {Tcl_FileCmd: dirname} { testsetplatform unix list [catch {file dirname /foo} msg] $msg } {0 /} test cmdah-2.14 {Tcl_FileCmd: dirname} { testsetplatform unix list [catch {file dirname //foo} msg] $msg } {0 /} test cmdah-2.15 {Tcl_FileCmd: dirname} { testsetplatform unix list [catch {file dirname //foo/bar} msg] $msg } {0 /foo} test cmdah-2.16 {Tcl_FileCmd: dirname} { testsetplatform unix list [catch {file dirname {//foo\/bar/baz}} msg] $msg } {0 {/foo\/bar}} test cmdah-2.17 {Tcl_FileCmd: dirname} { testsetplatform unix list [catch {file dirname {//foo\/bar/baz/blat}} msg] $msg } {0 {/foo\/bar/baz}} test cmdah-2.18 {Tcl_FileCmd: dirname} { testsetplatform unix list [catch {file dirname /foo//} msg] $msg } {0 /} test cmdah-2.19 {Tcl_FileCmd: dirname} { testsetplatform unix list [catch {file dirname ./a} msg] $msg } {0 .} test cmdah-2.20 {Tcl_FileCmd: dirname} { testsetplatform unix list [catch {file dirname a/.a} msg] $msg } {0 a} test cmdah-2.21 {Tcl_FileCmd: dirname} { testsetplatform windows list [catch {file dirname c:foo} msg] $msg } {0 c:} test cmdah-2.22 {Tcl_FileCmd: dirname} { testsetplatform windows list [catch {file dirname c:} msg] $msg } {0 c:} test cmdah-2.23 {Tcl_FileCmd: dirname} { testsetplatform windows list [catch {file dirname c:/} msg] $msg } {0 c:/} test cmdah-2.24 {Tcl_FileCmd: dirname} { testsetplatform windows list [catch {file dirname {c:\foo}} msg] $msg } {0 c:/} test cmdah-2.25 {Tcl_FileCmd: dirname} { testsetplatform windows list [catch {file dirname {//foo/bar/baz}} msg] $msg } {0 //foo/bar} test cmdah-2.26 {Tcl_FileCmd: dirname} { testsetplatform windows list [catch {file dirname {//foo/bar}} msg] $msg } {0 //foo/bar} test cmdah-2.27 {Tcl_FileCmd: dirname} { testsetplatform mac list [catch {file dirname :} msg] $msg } {0 :} test cmdah-2.28 {Tcl_FileCmd: dirname} { testsetplatform mac list [catch {file dirname :Foo} msg] $msg } {0 :} test cmdah-2.29 {Tcl_FileCmd: dirname} { testsetplatform mac list [catch {file dirname Foo:} msg] $msg } {0 Foo:} test cmdah-2.30 {Tcl_FileCmd: dirname} { testsetplatform mac list [catch {file dirname Foo:bar} msg] $msg } {0 Foo:} test cmdah-2.31 {Tcl_FileCmd: dirname} { testsetplatform mac list [catch {file dirname :Foo:bar} msg] $msg } {0 :Foo} test cmdah-2.32 {Tcl_FileCmd: dirname} { testsetplatform mac list [catch {file dirname ::} msg] $msg } {0 :} test cmdah-2.33 {Tcl_FileCmd: dirname} { testsetplatform mac list [catch {file dirname :::} msg] $msg } {0 ::} test cmdah-2.34 {Tcl_FileCmd: dirname} { testsetplatform mac list [catch {file dirname /foo/bar/} msg] $msg } {0 foo:} test cmdah-2.35 {Tcl_FileCmd: dirname} { testsetplatform mac list [catch {file dirname /foo/bar} msg] $msg } {0 foo:} test cmdah-2.36 {Tcl_FileCmd: dirname} { testsetplatform mac list [catch {file dirname /foo} msg] $msg } {0 foo:} test cmdah-2.37 {Tcl_FileCmd: dirname} { testsetplatform mac list [catch {file dirname foo} msg] $msg } {0 :} test cmdah-2.38 {Tcl_FileCmd: dirname} { testsetplatform unix list [catch {file dirname ~/foo} msg] $msg } {0 ~} test cmdah-2.39 {Tcl_FileCmd: dirname} { testsetplatform unix list [catch {file dirname ~bar/foo} msg] $msg } {0 ~bar} test cmdah-2.40 {Tcl_FileCmd: dirname} { testsetplatform mac list [catch {file dirname ~bar/foo} msg] $msg } {0 ~bar:} test cmdah-2.41 {Tcl_FileCmd: dirname} { testsetplatform mac list [catch {file dirname ~/foo} msg] $msg } {0 ~:} test cmdah-2.42 {Tcl_FileCmd: dirname} { testsetplatform mac list [catch {file dirname ~:baz} msg] $msg } {0 ~:} test cmdah-2.43 {Tcl_FileCmd: 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-2.44 {Tcl_FileCmd: 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-2.45 {Tcl_FileCmd: 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-2.46 {Tcl_FileCmd: 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-3.1 {Tcl_FileCmd: tail} { testsetplatform unix list [catch {file tail a b} msg] $msg } {1 {wrong # args: should be "file tail name"}} test cmdah-3.2 {Tcl_FileCmd: tail} { testsetplatform unix file tail /a/b } b test cmdah-3.3 {Tcl_FileCmd: tail} { testsetplatform unix file tail {} } {} test cmdah-3.4 {Tcl_FileCmd: tail} { testsetplatform mac file tail {} } {} test cmdah-3.5 {Tcl_FileCmd: tail} { testsetplatform win file tail {} } {} test cmdah-3.6 {Tcl_FileCmd: tail} { testsetplatform unix file tail .def } .def test cmdah-3.7 {Tcl_FileCmd: tail} { testsetplatform mac file tail a } a test cmdah-3.8 {Tcl_FileCmd: tail} { testsetplatform win file tail a } a test cmdah-3.9 {Tcl_FileCmd: tail} { testsetplatform unix file ta a/b/c.d } c.d test cmdah-3.10 {Tcl_FileCmd: tail} { testsetplatform unix file tail a/b.c/d } d test cmdah-3.11 {Tcl_FileCmd: tail} { testsetplatform unix file tail /. } . test cmdah-3.12 {Tcl_FileCmd: tail} { testsetplatform unix file tail / } {} test cmdah-3.13 {Tcl_FileCmd: tail} { testsetplatform unix file tail /foo } foo test cmdah-3.14 {Tcl_FileCmd: tail} { testsetplatform unix file tail //foo } foo test cmdah-3.15 {Tcl_FileCmd: tail} { testsetplatform unix file tail //foo/bar } bar test cmdah-3.16 {Tcl_FileCmd: tail} { testsetplatform unix file tail {//foo\/bar/baz} } baz test cmdah-3.17 {Tcl_FileCmd: tail} { testsetplatform unix file tail {//foo\/bar/baz/blat} } blat test cmdah-3.18 {Tcl_FileCmd: tail} { testsetplatform unix file tail /foo// } foo test cmdah-3.19 {Tcl_FileCmd: tail} { testsetplatform unix file tail ./a } a test cmdah-3.20 {Tcl_FileCmd: tail} { testsetplatform unix file tail a/.a } .a test cmdah-3.21 {Tcl_FileCmd: tail} { testsetplatform windows file tail c:foo } foo test cmdah-3.22 {Tcl_FileCmd: tail} { testsetplatform windows file tail c: } {} test cmdah-3.23 {Tcl_FileCmd: tail} { testsetplatform windows file tail c:/ } {} test cmdah-3.24 {Tcl_FileCmd: tail} { testsetplatform windows file tail {c:\foo} } foo test cmdah-3.25 {Tcl_FileCmd: tail} { testsetplatform windows file tail {//foo/bar/baz} } baz test cmdah-3.26 {Tcl_FileCmd: tail} { testsetplatform windows file tail {//foo/bar} } {} test cmdah-3.27 {Tcl_FileCmd: tail} { testsetplatform mac file tail : } : test cmdah-3.28 {Tcl_FileCmd: tail} { testsetplatform mac file tail :Foo } Foo test cmdah-3.29 {Tcl_FileCmd: tail} { testsetplatform mac file tail Foo: } {} test cmdah-3.30 {Tcl_FileCmd: tail} { testsetplatform mac file tail Foo:bar } bar test cmdah-3.31 {Tcl_FileCmd: tail} { testsetplatform mac file tail :Foo:bar } bar test cmdah-3.32 {Tcl_FileCmd: tail} { testsetplatform mac file tail :: } :: test cmdah-3.33 {Tcl_FileCmd: tail} { testsetplatform mac file tail ::: } :: test cmdah-3.34 {Tcl_FileCmd: tail} { testsetplatform mac file tail /foo/bar/ } bar test cmdah-3.35 {Tcl_FileCmd: tail} { testsetplatform mac file tail /foo/bar } bar test cmdah-3.36 {Tcl_FileCmd: tail} { testsetplatform mac file tail /foo } {} test cmdah-3.37 {Tcl_FileCmd: tail} { testsetplatform mac file tail foo } foo test cmdah-3.38 {Tcl_FileCmd: tail} { testsetplatform mac file tail ~:foo } foo test cmdah-3.39 {Tcl_FileCmd: tail} { testsetplatform mac file tail ~bar:foo } foo test cmdah-3.40 {Tcl_FileCmd: tail} { testsetplatform mac file tail ~bar/foo } foo test cmdah-3.41 {Tcl_FileCmd: tail} { testsetplatform mac file tail ~/foo } foo test cmdah-3.42 {Tcl_FileCmd: 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-3.43 {Tcl_FileCmd: tail} { global env set temp $env(HOME) set env(HOME) "~" testsetplatform unix set result [file tail ~] set env(HOME) $temp set result } {} test cmdah-3.44 {Tcl_FileCmd: 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-3.45 {Tcl_FileCmd: 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-3.46 {Tcl_FileCmd: tail} { testsetplatform unix file tail {f.oo\bar/baz.bat} } baz.bat test cmdah-3.47 {Tcl_FileCmd: tail} { testsetplatform windows file tail c:foo } foo test cmdah-3.48 {Tcl_FileCmd: tail} { testsetplatform windows file tail c: } {} test cmdah-3.49 {Tcl_FileCmd: tail} { testsetplatform windows file tail c:/foo } foo test cmdah-3.50 {Tcl_FileCmd: tail} { testsetplatform windows file tail {c:/foo\bar} } bar test cmdah-3.51 {Tcl_FileCmd: tail} { testsetplatform windows file tail {foo\bar} } bar # rootname test cmdah-4.1 {Tcl_FileCmd: rootname} { testsetplatform unix list [catch {file rootname a b} msg] $msg } {1 {wrong # args: should be "file rootname name"}} test cmdah-4.2 {Tcl_FileCmd: rootname} { testsetplatform unix file rootname {} } {} test cmdah-4.3 {Tcl_FileCmd: rootname} { testsetplatform unix file ro foo } foo test cmdah-4.4 {Tcl_FileCmd: rootname} { testsetplatform unix file rootname foo. } foo test cmdah-4.5 {Tcl_FileCmd: rootname} { testsetplatform unix file rootname .foo } {} test cmdah-4.6 {Tcl_FileCmd: rootname} { testsetplatform unix file rootname abc.def } abc test cmdah-4.7 {Tcl_FileCmd: rootname} { testsetplatform unix file rootname abc.def.ghi } abc.def test cmdah-4.8 {Tcl_FileCmd: rootname} { testsetplatform unix file rootname a/b/c.d } a/b/c test cmdah-4.9 {Tcl_FileCmd: rootname} { testsetplatform unix file rootname a/b.c/d } a/b.c/d test cmdah-4.10 {Tcl_FileCmd: rootname} { testsetplatform unix file rootname a/b.c/ } a/b.c/ test cmdah-4.11 {Tcl_FileCmd: rootname} { testsetplatform mac file ro foo } foo test cmdah-4.12 {Tcl_FileCmd: rootname} { testsetplatform mac file rootname {} } {} test cmdah-4.13 {Tcl_FileCmd: rootname} { testsetplatform mac file rootname foo. } foo test cmdah-4.14 {Tcl_FileCmd: rootname} { testsetplatform mac file rootname .foo } {} test cmdah-4.15 {Tcl_FileCmd: rootname} { testsetplatform mac file rootname abc.def } abc test cmdah-4.16 {Tcl_FileCmd: rootname} { testsetplatform mac file rootname abc.def.ghi } abc.def test cmdah-4.17 {Tcl_FileCmd: rootname} { testsetplatform mac file rootname a:b:c.d } a:b:c test cmdah-4.18 {Tcl_FileCmd: rootname} { testsetplatform mac file rootname a:b.c:d } a:b.c:d test cmdah-4.19 {Tcl_FileCmd: rootname} { testsetplatform mac file rootname a/b/c.d } a/b/c test cmdah-4.20 {Tcl_FileCmd: rootname} { testsetplatform mac file rootname a/b.c/d } a/b.c/d test cmdah-4.21 {Tcl_FileCmd: rootname} { testsetplatform mac file rootname /a.b } /a test cmdah-4.22 {Tcl_FileCmd: rootname} { testsetplatform mac file rootname foo.c: } foo.c: test cmdah-4.23 {Tcl_FileCmd: rootname} { testsetplatform windows file rootname {} } {} test cmdah-4.24 {Tcl_FileCmd: rootname} { testsetplatform windows file ro foo } foo test cmdah-4.25 {Tcl_FileCmd: rootname} { testsetplatform windows file rootname foo. } foo test cmdah-4.26 {Tcl_FileCmd: rootname} { testsetplatform windows file rootname .foo } {} test cmdah-4.27 {Tcl_FileCmd: rootname} { testsetplatform windows file rootname abc.def } abc test cmdah-4.28 {Tcl_FileCmd: rootname} { testsetplatform windows file rootname abc.def.ghi } abc.def test cmdah-4.29 {Tcl_FileCmd: rootname} { testsetplatform windows file rootname a/b/c.d } a/b/c test cmdah-4.30 {Tcl_FileCmd: rootname} { testsetplatform windows file rootname a/b.c/d } a/b.c/d test cmdah-4.31 {Tcl_FileCmd: rootname} { testsetplatform windows file rootname a\\b.c\\ } a\\b.c\\ test cmdah-4.32 {Tcl_FileCmd: rootname} { testsetplatform windows file rootname a\\b\\c.d } a\\b\\c test cmdah-4.33 {Tcl_FileCmd: rootname} { testsetplatform windows file rootname a\\b.c\\d } a\\b.c\\d test cmdah-4.34 {Tcl_FileCmd: 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-4.$num {Tcl_FileCmd: rootname and extension options} { testsetplatform unix format %s%s [file rootname $thing] [file ext $thing] } $thing set num [expr $num+1] } } # extension test cmdah-5.1 {Tcl_FileCmd: extension} { testsetplatform unix list [catch {file extension a b} msg] $msg } {1 {wrong # args: should be "file extension name"}} test cmdah-5.2 {Tcl_FileCmd: extension} { testsetplatform unix file extension {} } {} test cmdah-5.3 {Tcl_FileCmd: extension} { testsetplatform unix file ext foo } {} test cmdah-5.4 {Tcl_FileCmd: extension} { testsetplatform unix file extension foo. } . test cmdah-5.5 {Tcl_FileCmd: extension} { testsetplatform unix file extension .foo } .foo test cmdah-5.6 {Tcl_FileCmd: extension} { testsetplatform unix file extension abc.def } .def test cmdah-5.7 {Tcl_FileCmd: extension} { testsetplatform unix file extension abc.def.ghi } .ghi test cmdah-5.8 {Tcl_FileCmd: extension} { testsetplatform unix file extension a/b/c.d } .d test cmdah-5.9 {Tcl_FileCmd: extension} { testsetplatform unix file extension a/b.c/d } {} test cmdah-5.10 {Tcl_FileCmd: extension} { testsetplatform unix file extension a/b.c/ } {} test cmdah-5.11 {Tcl_FileCmd: extension} { testsetplatform mac file ext foo } {} test cmdah-5.12 {Tcl_FileCmd: extension} { testsetplatform mac file extension {} } {} test cmdah-5.13 {Tcl_FileCmd: extension} { testsetplatform mac file extension foo. } . test cmdah-5.14 {Tcl_FileCmd: extension} { testsetplatform mac file extension .foo } .foo test cmdah-5.15 {Tcl_FileCmd: extension} { testsetplatform mac file extension abc.def } .def test cmdah-5.16 {Tcl_FileCmd: extension} { testsetplatform mac file extension abc.def.ghi } .ghi test cmdah-5.17 {Tcl_FileCmd: extension} { testsetplatform mac file extension a:b:c.d } .d test cmdah-5.18 {Tcl_FileCmd: extension} { testsetplatform mac file extension a:b.c:d } {} test cmdah-5.19 {Tcl_FileCmd: extension} { testsetplatform mac file extension a/b/c.d } .d test cmdah-5.20 {Tcl_FileCmd: extension} { testsetplatform mac file extension a/b.c/d } {} test cmdah-5.21 {Tcl_FileCmd: extension} { testsetplatform mac file extension /a.b } .b test cmdah-5.22 {Tcl_FileCmd: extension} { testsetplatform mac file extension foo.c: } {} test cmdah-5.23 {Tcl_FileCmd: extension} { testsetplatform windows file extension {} } {} test cmdah-5.24 {Tcl_FileCmd: extension} { testsetplatform windows file ext foo } {} test cmdah-5.25 {Tcl_FileCmd: extension} { testsetplatform windows file extension foo. } . test cmdah-5.26 {Tcl_FileCmd: extension} { testsetplatform windows file extension .foo } .foo test cmdah-5.27 {Tcl_FileCmd: extension} { testsetplatform windows file extension abc.def } .def test cmdah-5.28 {Tcl_FileCmd: extension} { testsetplatform windows file extension abc.def.ghi } .ghi test cmdah-5.29 {Tcl_FileCmd: extension} { testsetplatform windows file extension a/b/c.d } .d test cmdah-5.30 {Tcl_FileCmd: extension} { testsetplatform windows file extension a/b.c/d } {} test cmdah-5.31 {Tcl_FileCmd: extension} { testsetplatform windows file extension a\\b.c\\ } {} test cmdah-5.32 {Tcl_FileCmd: extension} { testsetplatform windows file extension a\\b\\c.d } .d test cmdah-5.33 {Tcl_FileCmd: extension} { testsetplatform windows file extension a\\b.c\\d } {} test cmdah-5.34 {Tcl_FileCmd: extension} { testsetplatform windows file extension a\\b.c\\ } {} # pathtype test cmdah-6.1 {Tcl_FileCmd: pathtype} { testsetplatform unix list [catch {file pathtype a b} msg] $msg } {1 {wrong # args: should be "file pathtype name"}} test cmdah-6.2 {Tcl_FileCmd: pathtype} { testsetplatform unix file pathtype /a } absolute test cmdah-6.3 {Tcl_FileCmd: pathtype} { testsetplatform unix file p a } relative test cmdah-6.4 {Tcl_FileCmd: pathtype} { testsetplatform windows file pathtype c:a } volumerelative # split test cmdah-7.1 {Tcl_FileCmd: split} { testsetplatform unix list [catch {file split a b} msg] $msg } {1 {wrong # args: should be "file split name"}} test cmdah-7.2 {Tcl_FileCmd: split} { testsetplatform unix file split a } a test cmdah-7.3 {Tcl_FileCmd: split} { testsetplatform unix file split a/b } {a b} # join test cmdah-8.1 {Tcl_FileCmd: join} { testsetplatform unix file join a } a test cmdah-8.2 {Tcl_FileCmd: join} { testsetplatform unix file join a b } a/b test cmdah-8.3 {Tcl_FileCmd: join} { testsetplatform unix file join a b c d } a/b/c/d # error handling of Tcl_TranslateFileName test cmdah-9.1 {Tcl_FileCmd} { testsetplatform unix list [catch {file readable ~_bad_user} msg] $msg } {1 {user "_bad_user" doesn't exist}} makeFile abcde gorp.file makeDirectory dir.file # readable # Can't run on macintosh - requires chmod if {$tcl_platform(platform) != "macintosh"} { test cmdah-10.1 {Tcl_FileCmd: readable} { list [catch {file readable a b} msg] $msg } {1 {wrong # args: should be "file readable name"}} catch {exec chmod 444 gorp.file} test cmdah-10.2 {Tcl_FileCmd: readable} {unixExecs} {file readable gorp.file} 1 catch {exec chmod 333 gorp.file} if {$user != "root"} { test cmdah-10.3 {Tcl_FileCmd: readable} {unixOnly} { file reada gorp.file } 0 } } # writable # Can't run on macintosh - requires chmod if {$tcl_platform(platform) != "macintosh"} { test cmdah-11.1 {Tcl_FileCmd: writable} { list [catch {file writable a b} msg] $msg } {1 {wrong # args: should be "file writable name"}} catch {exec chmod 555 gorp.file} if {$user != "root"} { test cmdah-11.2 {Tcl_FileCmd: writable} {unixExecs} { file writable gorp.file } 0 } catch {exec chmod 222 gorp.file} test cmdah-11.3 {Tcl_FileCmd: writable} {unixExecs} {file w gorp.file} 1 } # executable # Can't run on macintosh - requires chmod if {$tcl_platform(platform) != "macintosh"} { test cmdah-12.1 {Tcl_FileCmd: executable} {unixExecs} { list [catch {file executable a b} msg] $msg } {1 {wrong # args: should be "file executable name"}} catch {exec chmod 000 dir.file} if {$user != "root"} { test cmdah-12.2 {Tcl_FileCmd: executable} {unixOnly} { file executable gorp.file } 0 } catch {exec chmod 775 gorp.file} test cmdah-12.3 {Tcl_FileCmd: executable} {unixExecs} {file exe gorp.file} 1 } # exists test cmdah-13.1 {Tcl_FileCmd: exists} { list [catch {file exists a b} msg] $msg } {1 {wrong # args: should be "file exists name"}} catch {exec chmod 777 dir.file} removeFile [file join dir.file gorp.file] removeFile gorp.file removeDirectory dir.file removeFile link.file test cmdah-13.2 {Tcl_FileCmd: exists} {file exists gorp.file} 0 test cmdah-13.3 {Tcl_FileCmd: 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-13.4 {Tcl_FileCmd: exists} {unixExecs} {file exists gorp.file} 1 test cmdah-13.5 {Tcl_FileCmd: exists} {unixExecs} { file exi [file join dir.file gorp.file] } 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"} { removeFile /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-13.3 {Tcl_FileCmd: exists} { file exists /tmp/tcl.foo.dir/file } 0 } exec chmod 775 /tmp/tcl.foo.dir removeFile /tmp/tcl.foo.dir/file removeDirectory /tmp/tcl.foo.dir } # Stat related commands removeFile gorp.file makeFile "Test string" gorp.file catch {exec chmod 765 gorp.file} # atime test cmdah-14.1 {Tcl_FileCmd: atime} { list [catch {file atime a b} msg] $msg } {1 {wrong # args: should be "file atime name"}} test cmdah-14.2 {Tcl_FileCmd: 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-12.1 {Tcl_FileCmd: 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-15.1 {Tcl_FileCmd: isdirectory} { list [catch {file isdirectory a b} msg] $msg } {1 {wrong # args: should be "file isdirectory name"}} test cmdah-15.2 {Tcl_FileCmd: isdirectory} {file isdirectory gorp.file} 0 test cmdah-15.3 {Tcl_FileCmd: isdirectory} {unixExecs} {file isd dir.file} 1 # isfile test cmdah-15.4 {Tcl_FileCmd: isfile} { list [catch {file isfile a b} msg] $msg } {1 {wrong # args: should be "file isfile name"}} test cmdah-15.5 {Tcl_FileCmd: isfile} {file isfile gorp.file} 1 test cmdah-15.6 {Tcl_FileCmd: 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-16.1 {Tcl_FileCmd: lstat} {unixExecs} { list [catch {file lstat a} msg] $msg } {1 {wrong # args: should be "file lstat name varName"}} test cmdah-16.2 {Tcl_FileCmd: lstat} {unixExecs} { list [catch {file lstat a b c} msg] $msg } {1 {wrong # args: should be "file lstat name varName"}} test cmdah-16.3 {Tcl_FileCmd: 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-16.4 {Tcl_FileCmd: 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-16.5 {Tcl_FileCmd: 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-16.6 {Tcl_FileCmd: lstat errors} {unixExecs nonPortable} { 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-17.1 {Tcl_FileCmd: mtime} { list [catch {file mtime a b} msg] $msg } {1 {wrong # args: should be "file mtime name"}} test cmdah-17.2 {Tcl_FileCmd: mtime} {unixExecs} { 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-17.3 {Tcl_FileCmd: mtime} {unixExecs} { 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-17.4 {Tcl_FileCmd: mtime} {unixExecs} { 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}}} # owned test cmdah-18.1 {Tcl_FileCmd: owned} { list [catch {file owned a b} msg] $msg } {1 {wrong # args: should be "file owned name"}} test cmdah-18.2 {Tcl_FileCmd: owned} {unixExecs} {file owned gorp.file} 1 if {$user != "root"} { test cmdah-18.3 {Tcl_FileCmd: owned} {unixOnly} {file owned /} 0 } # readlink test cmdah-19.1 {Tcl_FileCmd: readlink} { list [catch {file readlink a b} msg] $msg } {1 {wrong # args: should be "file readlink name"}} test cmdah-19.2 {Tcl_FileCmd: readlink} {unixOnly nonPortable} { file readlink link.file } gorp.file test cmdah-19.3 {Tcl_FileCmd: 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-19.4 {Tcl_FileCmd: 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-19.5 {Tcl_FileCmd: 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-20.1 {Tcl_FileCmd: size} { list [catch {file size a b} msg] $msg } {1 {wrong # args: should be "file size name"}} test cmdah-20.2 {Tcl_FileCmd: 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-20.3 {Tcl_FileCmd: 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 makeFile "Test string" gorp.file catch {exec chmod 765 gorp.file} test cmdah-21.1 {Tcl_FileCmd: stat} { list [catch {file stat _bogus_} msg] $msg $errorCode } {1 {wrong # args: should be "file stat name varName"} NONE} test cmdah-21.2 {Tcl_FileCmd: stat} { list [catch {file stat _bogus_ a b} msg] $msg $errorCode } {1 {wrong # args: should be "file stat name varName"} NONE} test cmdah-21.3 {Tcl_FileCmd: 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-21.4 {Tcl_FileCmd: stat} {unixOnly} { catch {unset stat} file stat gorp.file stat list $stat(nlink) $stat(size) [expr $stat(mode)&0777] $stat(type) } {1 12 501 file} test cmdah-21.5 {Tcl_FileCmd: 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-21.6 {Tcl_FileCmd: 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 removeFile link.file test cmdah-22.1 {Tcl_FileCmd: type} { list [catch {file size a b} msg] $msg } {1 {wrong # args: should be "file size name"}} test cmdah-22.2 {Tcl_FileCmd: type} {unixExecs} { file type dir.file } directory test cmdah-22.3 {Tcl_FileCmd: type} { file type gorp.file } file test cmdah-22.4 {Tcl_FileCmd: type} {unixOnly nonPortable} { exec ln -s a/b/c link.file set result [file type link.file] removeFile link.file set result } link test cmdah-22.5 {Tcl_FileCmd: 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-23.1 {error conditions} { list [catch {file gorp x} msg] $msg } {1 {bad option "gorp": should be atime, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, owned, pathtype, readable, readlink, root, size, split, stat, tail, type, or writable}} test cmdah-23.2 {error conditions} { list [catch {file ex x} msg] $msg } {1 {bad option "ex": should be atime, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, owned, pathtype, readable, readlink, root, size, split, stat, tail, type, or writable}} test cmdah-23.3 {error conditions} { list [catch {file is x} msg] $msg } {1 {bad option "is": should be atime, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, owned, pathtype, readable, readlink, root, size, split, stat, tail, type, or writable}} test cmdah-23.4 {error conditions} { list [catch {file n x} msg] $msg } {1 {bad option "n": should be atime, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, owned, pathtype, readable, readlink, root, size, split, stat, tail, type, or writable}} test cmdah-23.5 {error conditions} { list [catch {file read x} msg] $msg } {1 {bad option "read": should be atime, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, owned, pathtype, readable, readlink, root, size, split, stat, tail, type, or writable}} test cmdah-23.6 {error conditions} { list [catch {file s x} msg] $msg } {1 {bad option "s": should be atime, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, owned, pathtype, readable, readlink, root, size, split, stat, tail, type, or writable}} test cmdah-23.7 {error conditions} { list [catch {file t x} msg] $msg } {1 {bad option "t": should be atime, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, owned, pathtype, readable, readlink, root, size, split, stat, tail, type, or writable}} test cmdah-23.8 {error conditions} { list [catch {file dirname ~woohgy} msg] $msg } {1 {user "woohgy" doesn't exist}} catch {exec chmod 777 dir.file} removeFile dir.file/gorp.file removeFile gorp.file removeDirectory dir.file removeFile link.file testsetplatform $platform catch {unset platform} concat ""