archie/tcl7.6/tests/cmdAH.test
2024-05-27 16:40:40 +02:00

1149 lines
33 KiB
Plaintext

# 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.13 96/10/08 15:55:00
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\\
} {}
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-5.$num {Tcl_FileCmd: extension} "
testsetplatform $p
file extension $value
" $result
incr num
}
}
# 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}}
testsetplatform $platform
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}
file delete -force dir.file
file delete gorp.file
file delete 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 exists [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"} {
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-13.6 {Tcl_FileCmd: 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-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
testsetplatform $platform
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
file delete 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]
file delete 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, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, owned, pathtype, readable, readlink, rename, 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, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, owned, pathtype, readable, readlink, rename, 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, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, owned, pathtype, readable, readlink, rename, 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, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, owned, pathtype, readable, readlink, rename, 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, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, owned, pathtype, readable, readlink, rename, 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, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, owned, pathtype, readable, readlink, rename, 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, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, owned, pathtype, readable, readlink, rename, 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}}
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 ""