-# The file tests the tclCmdAH.c file.\r#\r# This file contains a collection of tests for one or more of the Tcl\r# built-in commands. Sourcing this file into Tcl runs the tests and\r# generates output for errors. No output means no errors were found.\r#\r# Copyright (c) 1996-1998 by Sun Microsystems, Inc.\r# Copyright (c) 1998-1999 by Scriptics Corporation.\r#\r# See the file "license.terms" for information on usage and redistribution\r# of this file, and for a DISCLAIMER OF ALL WARRANTIES.\r#\r# RCS: @(#) $Id$\r\rif {[lsearch [namespace children] ::tcltest] == -1} {\r package require tcltest\r namespace import -force ::tcltest::*\r}\r\rtcltest::testConstraint testchmod [string equal testchmod [info commands testchmod]]\rtcltest::testConstraint fsIsWritable [expr {1 - [catch {file mkdir isreadonly ; file delete isreadonly}]}]\r\rglobal env\rset cmdAHwd [pwd]\rcatch {set platform [testgetplatform]}\r\rtest cmdAH-0.1 {Tcl_BreakObjCmd, errors} {\r list [catch {break foo} msg] $msg\r} {1 {wrong # args: should be "break"}}\rtest cmdAH-0.2 {Tcl_BreakObjCmd, success} {\r list [catch {break} msg] $msg\r} {3 {}}\r\r# Tcl_CaseObjCmd is tested in case.test\r\rtest cmdAH-1.1 {Tcl_CatchObjCmd, errors} {\r list [catch {catch} msg] $msg\r} {1 {wrong # args: should be "catch command ?varName?"}}\rtest cmdAH-1.2 {Tcl_CatchObjCmd, errors} {\r list [catch {catch foo bar baz} msg] $msg\r} {1 {wrong # args: should be "catch command ?varName?"}}\r\rtest cmdAH-2.1 {Tcl_CdObjCmd} {\r list [catch {cd foo bar} msg] $msg\r} {1 {wrong # args: should be "cd ?dirName?"}}\rtest cmdAH-2.2 {Tcl_CdObjCmd} {fsIsWritable} {\r file delete -force foo\r file mkdir foo\r cd foo\r set result [file tail [pwd]]\r cd ..\r file delete foo\r set result\r} foo\rtest cmdAH-2.3 {Tcl_CdObjCmd} {fsIsWritable} {\r global env\r set oldpwd [pwd]\r set temp $env(HOME)\r set env(HOME) $oldpwd\r file delete -force foo\r file mkdir foo\r cd foo\r cd ~\r set result [string match [pwd] $oldpwd]\r file delete foo\r set env(HOME) $temp\r set result\r} 1\rtest cmdAH-2.4 {Tcl_CdObjCmd} {fsIsWritable} {\r global env\r set oldpwd [pwd]\r set temp $env(HOME)\r set env(HOME) $oldpwd\r file delete -force foo\r file mkdir foo\r cd foo\r cd\r set result [string match [pwd] $oldpwd]\r file delete foo\r set env(HOME) $temp\r set result\r} 1\rtest cmdAH-2.5 {Tcl_CdObjCmd} {\r list [catch {cd ~~} msg] $msg\r} {1 {user "~" doesn't exist}}\rtest cmdAH-2.6 {Tcl_CdObjCmd} {\r list [catch {cd _foobar} msg] $msg\r} {1 {couldn't change working directory to "_foobar": no such file or directory}}\r\rtest cmdAH-2.7 {Tcl_ConcatObjCmd} {\r concat\r} {}\rtest cmdAH-2.8 {Tcl_ConcatObjCmd} {\r concat a\r} a\rtest cmdAH-2.9 {Tcl_ConcatObjCmd} {\r concat a {b c}\r} {a b c}\r\rtest cmdAH-3.1 {Tcl_ContinueObjCmd, errors} {\r list [catch {continue foo} msg] $msg\r} {1 {wrong # args: should be "continue"}}\rtest cmdAH-3.2 {Tcl_ContinueObjCmd, success} {\r list [catch {continue} msg] $msg\r} {4 {}}\r\rtest cmdAH-4.1 {Tcl_EncodingObjCmd} {\r list [catch {encoding} msg] $msg\r} {1 {wrong # args: should be "encoding option ?arg ...?"}}\rtest cmdAH-4.2 {Tcl_EncodingObjCmd} {\r list [catch {encoding foo} msg] $msg\r} {1 {bad option "foo": must be convertfrom, convertto, names, or system}}\rtest cmdAH-4.3 {Tcl_EncodingObjCmd} {\r list [catch {encoding convertto} msg] $msg\r} {1 {wrong # args: should be "encoding convertto ?encoding? data"}}\rtest cmdAH-4.4 {Tcl_EncodingObjCmd} {\r list [catch {encoding convertto foo bar} msg] $msg\r} {1 {unknown encoding "foo"}}\rtest cmdAH-4.5 {Tcl_EncodingObjCmd} {\r set system [encoding system]\r encoding system jis0208\r set x [encoding convertto \u4e4e]\r encoding system $system\r set x\r} 8C\rtest cmdAH-4.6 {Tcl_EncodingObjCmd} {\r set system [encoding system]\r encoding system identity\r set x [encoding convertto jis0208 \u4e4e]\r encoding system $system\r set x\r} 8C\rtest cmdAH-4.7 {Tcl_EncodingObjCmd} {\r list [catch {encoding convertfrom} msg] $msg\r} {1 {wrong # args: should be "encoding convertfrom ?encoding? data"}}\rtest cmdAH-4.8 {Tcl_EncodingObjCmd} {\r list [catch {encoding convertfrom foo bar} msg] $msg\r} {1 {unknown encoding "foo"}}\rtest cmdAH-4.9 {Tcl_EncodingObjCmd} {\r set system [encoding system]\r encoding system jis0208\r set x [encoding convertfrom 8C]\r encoding system $system\r set x\r} \u4e4e\rtest cmdAH-4.10 {Tcl_EncodingObjCmd} {\r set system [encoding system]\r encoding system identity\r set x [encoding convertfrom jis0208 8C]\r encoding system $system\r set x\r} \u4e4e\rtest cmdAH-4.11 {Tcl_EncodingObjCmd} {\r list [catch {encoding names foo} msg] $msg\r} {1 {wrong # args: should be "encoding names"}}\rtest cmdAH-4.12 {Tcl_EncodingObjCmd} {\r list [catch {encoding system foo bar} msg] $msg\r} {1 {wrong # args: should be "encoding system ?encoding?"}}\rtest cmdAH-4.13 {Tcl_EncodingObjCmd} {\r set system [encoding system]\r encoding system identity\r set x [encoding system]\r encoding system $system\r set x\r} identity\r\rtest cmdAH-5.1 {Tcl_FileObjCmd} {\r list [catch file msg] $msg\r} {1 {wrong # args: should be "file option ?arg ...?"}}\rtest cmdAH-5.2 {Tcl_FileObjCmd} {\r list [catch {file x} msg] $msg\r} {1 {bad option "x": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, type, volumes, or writable}}\rtest cmdAH-5.3 {Tcl_FileObjCmd} {\r list [catch {file exists} msg] $msg\r} {1 {wrong # args: should be "file exists name"}}\rtest cmdAH-5.4 {Tcl_FileObjCmd} {\r list [catch {file exists ""} msg] $msg\r} {0 0}\r\r#volume\r\rtest cmdAH-6.1 {Tcl_FileObjCmd: volumes} {\r list [catch {file volumes x} msg] $msg \r} {1 {wrong # args: should be "file volumes"}}\rtest cmdAH-6.2 {Tcl_FileObjCmd: volumes} {\r set volumeList [file volumes]\r if { [llength $volumeList] == 0 } {\r set result 0\r } else {\r set result 1\r } \r} {1}\rtest cmdAH-6.3 {Tcl_FileObjCmd: volumes} {macOrUnix} {\r set volumeList [file volumes]\r catch [list glob -nocomplain [lindex $volumeList 0]*]\r} {0}\rtest cmdAH-6.4 {Tcl_FileObjCmd: volumes} {pcOnly} {\r set volumeList [string tolower [file volumes]]\r list [catch {lsearch $volumeList "c:/"} element] [expr $element != -1] [catch {list glob -nocomplain [lindex $volumeList $element]*}]\r} {0 1 0}\r\r# attributes\r\rtest cmdAH-7.1 {Tcl_FileObjCmd - file attrs} {fsIsWritable} {\r catch {file delete -force foo.file}\r close [open foo.file w]\r list [catch {file attributes foo.file}] [file delete -force foo.file]\r} {0 {}}\r\r# dirname\r\rif {[info commands testsetplatform] == {}} {\r puts "This application hasn't been compiled with the \"testsetplatform\""\r puts "command, so I can't test Tcl_FileObjCmd etc."\r} else {\rtest cmdAH-8.1 {Tcl_FileObjCmd: dirname} {\r testsetplatform unix\r list [catch {file dirname a b} msg] $msg\r} {1 {wrong # args: should be "file dirname name"}}\rtest cmdAH-8.2 {Tcl_FileObjCmd: dirname} {\r testsetplatform unix\r file dirname /a/b\r} /a\rtest cmdAH-8.3 {Tcl_FileObjCmd: dirname} {\r testsetplatform unix\r file dirname {}\r} .\rtest cmdAH-8.4 {Tcl_FileObjCmd: dirname} {\r testsetplatform mac\r file dirname {}\r} :\rtest cmdAH-8.5 {Tcl_FileObjCmd: dirname} {\r testsetplatform win\r file dirname {}\r} .\rtest cmdAH-8.6 {Tcl_FileObjCmd: dirname} {\r testsetplatform unix\r file dirname .def\r} .\rtest cmdAH-8.7 {Tcl_FileObjCmd: dirname} {\r testsetplatform mac\r file dirname a\r} :\rtest cmdAH-8.8 {Tcl_FileObjCmd: dirname} {\r testsetplatform win\r file dirname a\r} .\rtest cmdAH-8.9 {Tcl_FileObjCmd: dirname} {\r testsetplatform unix\r file dirname a/b/c.d\r} a/b\rtest cmdAH-8.10 {Tcl_FileObjCmd: dirname} {\r testsetplatform unix\r file dirname a/b.c/d\r} a/b.c\rtest cmdAH-8.11 {Tcl_FileObjCmd: dirname} {\r testsetplatform unix\r file dirname /.\r} /\rtest cmdAH-8.12 {Tcl_FileObjCmd: dirname} {\r testsetplatform unix\r list [catch {file dirname /} msg] $msg\r} {0 /}\rtest cmdAH-8.13 {Tcl_FileObjCmd: dirname} {\r testsetplatform unix\r list [catch {file dirname /foo} msg] $msg\r} {0 /}\rtest cmdAH-8.14 {Tcl_FileObjCmd: dirname} {\r testsetplatform unix\r list [catch {file dirname //foo} msg] $msg\r} {0 /}\rtest cmdAH-8.15 {Tcl_FileObjCmd: dirname} {\r testsetplatform unix\r list [catch {file dirname //foo/bar} msg] $msg\r} {0 /foo}\rtest cmdAH-8.16 {Tcl_FileObjCmd: dirname} {\r testsetplatform unix\r list [catch {file dirname {//foo\/bar/baz}} msg] $msg\r} {0 {/foo\/bar}}\rtest cmdAH-8.17 {Tcl_FileObjCmd: dirname} {\r testsetplatform unix\r list [catch {file dirname {//foo\/bar/baz/blat}} msg] $msg\r} {0 {/foo\/bar/baz}}\rtest cmdAH-8.18 {Tcl_FileObjCmd: dirname} {\r testsetplatform unix\r list [catch {file dirname /foo//} msg] $msg\r} {0 /}\rtest cmdAH-8.19 {Tcl_FileObjCmd: dirname} {\r testsetplatform unix\r list [catch {file dirname ./a} msg] $msg\r} {0 .}\rtest cmdAH-8.20 {Tcl_FileObjCmd: dirname} {\r testsetplatform unix\r list [catch {file dirname a/.a} msg] $msg\r} {0 a}\rtest cmdAH-8.21 {Tcl_FileObjCmd: dirname} {\r testsetplatform windows\r list [catch {file dirname c:foo} msg] $msg\r} {0 c:}\rtest cmdAH-8.22 {Tcl_FileObjCmd: dirname} {\r testsetplatform windows\r list [catch {file dirname c:} msg] $msg\r} {0 c:}\rtest cmdAH-8.23 {Tcl_FileObjCmd: dirname} {\r testsetplatform windows\r list [catch {file dirname c:/} msg] $msg\r} {0 c:/}\rtest cmdAH-8.24 {Tcl_FileObjCmd: dirname} {\r testsetplatform windows\r list [catch {file dirname {c:\foo}} msg] $msg\r} {0 c:/}\rtest cmdAH-8.25 {Tcl_FileObjCmd: dirname} {\r testsetplatform windows\r list [catch {file dirname {//foo/bar/baz}} msg] $msg\r} {0 //foo/bar}\rtest cmdAH-8.26 {Tcl_FileObjCmd: dirname} {\r testsetplatform windows\r list [catch {file dirname {//foo/bar}} msg] $msg\r} {0 //foo/bar}\rtest cmdAH-8.27 {Tcl_FileObjCmd: dirname} {\r testsetplatform mac\r list [catch {file dirname :} msg] $msg\r} {0 :}\rtest cmdAH-8.28 {Tcl_FileObjCmd: dirname} {\r testsetplatform mac\r list [catch {file dirname :Foo} msg] $msg\r} {0 :}\rtest cmdAH-8.29 {Tcl_FileObjCmd: dirname} {\r testsetplatform mac\r list [catch {file dirname Foo:} msg] $msg\r} {0 Foo:}\rtest cmdAH-8.30 {Tcl_FileObjCmd: dirname} {\r testsetplatform mac\r list [catch {file dirname Foo:bar} msg] $msg\r} {0 Foo:}\rtest cmdAH-8.31 {Tcl_FileObjCmd: dirname} {\r testsetplatform mac\r list [catch {file dirname :Foo:bar} msg] $msg\r} {0 :Foo}\rtest cmdAH-8.32 {Tcl_FileObjCmd: dirname} {\r testsetplatform mac\r list [catch {file dirname ::} msg] $msg\r} {0 :}\rtest cmdAH-8.33 {Tcl_FileObjCmd: dirname} {\r testsetplatform mac\r list [catch {file dirname :::} msg] $msg\r} {0 ::}\rtest cmdAH-8.34 {Tcl_FileObjCmd: dirname} {\r testsetplatform mac\r list [catch {file dirname /foo/bar/} msg] $msg\r} {0 foo:}\rtest cmdAH-8.35 {Tcl_FileObjCmd: dirname} {\r testsetplatform mac\r list [catch {file dirname /foo/bar} msg] $msg\r} {0 foo:}\rtest cmdAH-8.36 {Tcl_FileObjCmd: dirname} {\r testsetplatform mac\r list [catch {file dirname /foo} msg] $msg\r} {0 foo:}\rtest cmdAH-8.37 {Tcl_FileObjCmd: dirname} {\r testsetplatform mac\r list [catch {file dirname foo} msg] $msg\r} {0 :}\rtest cmdAH-8.38 {Tcl_FileObjCmd: dirname} {\r testsetplatform unix\r list [catch {file dirname ~/foo} msg] $msg\r} {0 ~}\rtest cmdAH-8.39 {Tcl_FileObjCmd: dirname} {\r testsetplatform unix\r list [catch {file dirname ~bar/foo} msg] $msg\r} {0 ~bar}\rtest cmdAH-8.40 {Tcl_FileObjCmd: dirname} {\r testsetplatform mac\r list [catch {file dirname ~bar/foo} msg] $msg\r} {0 ~bar:}\rtest cmdAH-8.41 {Tcl_FileObjCmd: dirname} {\r testsetplatform mac\r list [catch {file dirname ~/foo} msg] $msg\r} {0 ~:}\rtest cmdAH-8.42 {Tcl_FileObjCmd: dirname} {\r testsetplatform mac\r list [catch {file dirname ~:baz} msg] $msg\r} {0 ~:}\rtest cmdAH-8.43 {Tcl_FileObjCmd: dirname} {\r global env\r set temp $env(HOME)\r set env(HOME) "/home/test"\r testsetplatform unix\r set result [list [catch {file dirname ~} msg] $msg]\r set env(HOME) $temp\r set result\r} {0 /home}\rtest cmdAH-8.44 {Tcl_FileObjCmd: dirname} {\r global env\r set temp $env(HOME)\r set env(HOME) "~"\r testsetplatform unix\r set result [list [catch {file dirname ~} msg] $msg]\r set env(HOME) $temp\r set result\r} {0 ~}\rtest cmdAH-8.45 {Tcl_FileObjCmd: dirname} {\r global env\r set temp $env(HOME)\r set env(HOME) "/home/test"\r testsetplatform windows\r set result [list [catch {file dirname ~} msg] $msg]\r set env(HOME) $temp\r set result\r} {0 /home}\rtest cmdAH-8.46 {Tcl_FileObjCmd: dirname} {\r global env\r set temp $env(HOME)\r set env(HOME) "/home/test"\r testsetplatform mac\r set result [list [catch {file dirname ~} msg] $msg]\r set env(HOME) $temp\r set result\r} {0 home:}\r\r# tail\r\rtest cmdAH-9.1 {Tcl_FileObjCmd: tail} {\r testsetplatform unix\r list [catch {file tail a b} msg] $msg\r} {1 {wrong # args: should be "file tail name"}}\rtest cmdAH-9.2 {Tcl_FileObjCmd: tail} {\r testsetplatform unix\r file tail /a/b\r} b\rtest cmdAH-9.3 {Tcl_FileObjCmd: tail} {\r testsetplatform unix\r file tail {}\r} {}\rtest cmdAH-9.4 {Tcl_FileObjCmd: tail} {\r testsetplatform mac\r file tail {}\r} {}\rtest cmdAH-9.5 {Tcl_FileObjCmd: tail} {\r testsetplatform win\r file tail {}\r} {}\rtest cmdAH-9.6 {Tcl_FileObjCmd: tail} {\r testsetplatform unix\r file tail .def\r} .def\rtest cmdAH-9.7 {Tcl_FileObjCmd: tail} {\r testsetplatform mac\r file tail a\r} a\rtest cmdAH-9.8 {Tcl_FileObjCmd: tail} {\r testsetplatform win\r file tail a\r} a\rtest cmdAH-9.9 {Tcl_FileObjCmd: tail} {\r testsetplatform unix\r file ta a/b/c.d\r} c.d\rtest cmdAH-9.10 {Tcl_FileObjCmd: tail} {\r testsetplatform unix\r file tail a/b.c/d\r} d\rtest cmdAH-9.11 {Tcl_FileObjCmd: tail} {\r testsetplatform unix\r file tail /.\r} .\rtest cmdAH-9.12 {Tcl_FileObjCmd: tail} {\r testsetplatform unix\r file tail /\r} {}\rtest cmdAH-9.13 {Tcl_FileObjCmd: tail} {\r testsetplatform unix\r file tail /foo\r} foo\rtest cmdAH-9.14 {Tcl_FileObjCmd: tail} {\r testsetplatform unix\r file tail //foo\r} foo\rtest cmdAH-9.15 {Tcl_FileObjCmd: tail} {\r testsetplatform unix\r file tail //foo/bar\r} bar\rtest cmdAH-9.16 {Tcl_FileObjCmd: tail} {\r testsetplatform unix\r file tail {//foo\/bar/baz}\r} baz\rtest cmdAH-9.17 {Tcl_FileObjCmd: tail} {\r testsetplatform unix\r file tail {//foo\/bar/baz/blat}\r} blat\rtest cmdAH-9.18 {Tcl_FileObjCmd: tail} {\r testsetplatform unix\r file tail /foo//\r} foo\rtest cmdAH-9.19 {Tcl_FileObjCmd: tail} {\r testsetplatform unix\r file tail ./a\r} a\rtest cmdAH-9.20 {Tcl_FileObjCmd: tail} {\r testsetplatform unix\r file tail a/.a\r} .a\rtest cmdAH-9.21 {Tcl_FileObjCmd: tail} {\r testsetplatform windows\r file tail c:foo\r} foo\rtest cmdAH-9.22 {Tcl_FileObjCmd: tail} {\r testsetplatform windows\r file tail c:\r} {}\rtest cmdAH-9.23 {Tcl_FileObjCmd: tail} {\r testsetplatform windows\r file tail c:/\r} {}\rtest cmdAH-9.24 {Tcl_FileObjCmd: tail} {\r testsetplatform windows\r file tail {c:\foo}\r} foo\rtest cmdAH-9.25 {Tcl_FileObjCmd: tail} {\r testsetplatform windows\r file tail {//foo/bar/baz}\r} baz\rtest cmdAH-9.26 {Tcl_FileObjCmd: tail} {\r testsetplatform windows\r file tail {//foo/bar}\r} {}\rtest cmdAH-9.27 {Tcl_FileObjCmd: tail} {\r testsetplatform mac\r file tail :\r} :\rtest cmdAH-9.28 {Tcl_FileObjCmd: tail} {\r testsetplatform mac\r file tail :Foo\r} Foo\rtest cmdAH-9.29 {Tcl_FileObjCmd: tail} {\r testsetplatform mac\r file tail Foo:\r} {}\rtest cmdAH-9.30 {Tcl_FileObjCmd: tail} {\r testsetplatform mac\r file tail Foo:bar\r} bar\rtest cmdAH-9.31 {Tcl_FileObjCmd: tail} {\r testsetplatform mac\r file tail :Foo:bar\r} bar\rtest cmdAH-9.32 {Tcl_FileObjCmd: tail} {\r testsetplatform mac\r file tail ::\r} ::\rtest cmdAH-9.33 {Tcl_FileObjCmd: tail} {\r testsetplatform mac\r file tail :::\r} ::\rtest cmdAH-9.34 {Tcl_FileObjCmd: tail} {\r testsetplatform mac\r file tail /foo/bar/\r} bar\rtest cmdAH-9.35 {Tcl_FileObjCmd: tail} {\r testsetplatform mac\r file tail /foo/bar\r} bar\rtest cmdAH-9.36 {Tcl_FileObjCmd: tail} {\r testsetplatform mac\r file tail /foo\r} {}\rtest cmdAH-9.37 {Tcl_FileObjCmd: tail} {\r testsetplatform mac\r file tail foo\r} foo\rtest cmdAH-9.38 {Tcl_FileObjCmd: tail} {\r testsetplatform mac\r file tail ~:foo\r} foo\rtest cmdAH-9.39 {Tcl_FileObjCmd: tail} {\r testsetplatform mac\r file tail ~bar:foo\r} foo\rtest cmdAH-9.40 {Tcl_FileObjCmd: tail} {\r testsetplatform mac\r file tail ~bar/foo\r} foo\rtest cmdAH-9.41 {Tcl_FileObjCmd: tail} {\r testsetplatform mac\r file tail ~/foo\r} foo\rtest cmdAH-9.42 {Tcl_FileObjCmd: tail} {\r global env\r set temp $env(HOME)\r set env(HOME) "/home/test"\r testsetplatform unix\r set result [file tail ~]\r set env(HOME) $temp\r set result\r} test\rtest cmdAH-9.43 {Tcl_FileObjCmd: tail} {\r global env\r set temp $env(HOME)\r set env(HOME) "~"\r testsetplatform unix\r set result [file tail ~]\r set env(HOME) $temp\r set result\r} {}\rtest cmdAH-9.44 {Tcl_FileObjCmd: tail} {\r global env\r set temp $env(HOME)\r set env(HOME) "/home/test"\r testsetplatform windows\r set result [file tail ~]\r set env(HOME) $temp\r set result\r} test\rtest cmdAH-9.45 {Tcl_FileObjCmd: tail} {\r global env\r set temp $env(HOME)\r set env(HOME) "/home/test"\r testsetplatform mac\r set result [file tail ~]\r set env(HOME) $temp\r set result\r} test\rtest cmdAH-9.46 {Tcl_FileObjCmd: tail} {\r testsetplatform unix\r file tail {f.oo\bar/baz.bat}\r} baz.bat\rtest cmdAH-9.47 {Tcl_FileObjCmd: tail} {\r testsetplatform windows\r file tail c:foo\r} foo\rtest cmdAH-9.48 {Tcl_FileObjCmd: tail} {\r testsetplatform windows\r file tail c:\r} {}\rtest cmdAH-9.49 {Tcl_FileObjCmd: tail} {\r testsetplatform windows\r file tail c:/foo\r} foo\rtest cmdAH-9.50 {Tcl_FileObjCmd: tail} {\r testsetplatform windows\r file tail {c:/foo\bar}\r} bar\rtest cmdAH-9.51 {Tcl_FileObjCmd: tail} {\r testsetplatform windows\r file tail {foo\bar}\r} bar\r\r# rootname\r\rtest cmdAH-10.1 {Tcl_FileObjCmd: rootname} {\r testsetplatform unix\r list [catch {file rootname a b} msg] $msg\r} {1 {wrong # args: should be "file rootname name"}}\rtest cmdAH-10.2 {Tcl_FileObjCmd: rootname} {\r testsetplatform unix\r file rootname {}\r} {}\rtest cmdAH-10.3 {Tcl_FileObjCmd: rootname} {\r testsetplatform unix\r file ro foo\r} foo\rtest cmdAH-10.4 {Tcl_FileObjCmd: rootname} {\r testsetplatform unix\r file rootname foo.\r} foo\rtest cmdAH-10.5 {Tcl_FileObjCmd: rootname} {\r testsetplatform unix\r file rootname .foo\r} {}\rtest cmdAH-10.6 {Tcl_FileObjCmd: rootname} {\r testsetplatform unix\r file rootname abc.def\r} abc\rtest cmdAH-10.7 {Tcl_FileObjCmd: rootname} {\r testsetplatform unix\r file rootname abc.def.ghi\r} abc.def\rtest cmdAH-10.8 {Tcl_FileObjCmd: rootname} {\r testsetplatform unix\r file rootname a/b/c.d\r} a/b/c\rtest cmdAH-10.9 {Tcl_FileObjCmd: rootname} {\r testsetplatform unix\r file rootname a/b.c/d\r} a/b.c/d\rtest cmdAH-10.10 {Tcl_FileObjCmd: rootname} {\r testsetplatform unix\r file rootname a/b.c/\r} a/b.c/\rtest cmdAH-10.11 {Tcl_FileObjCmd: rootname} {\r testsetplatform mac\r file ro foo\r} foo\rtest cmdAH-10.12 {Tcl_FileObjCmd: rootname} {\r testsetplatform mac\r file rootname {}\r} {}\rtest cmdAH-10.13 {Tcl_FileObjCmd: rootname} {\r testsetplatform mac\r file rootname foo.\r} foo\rtest cmdAH-10.14 {Tcl_FileObjCmd: rootname} {\r testsetplatform mac\r file rootname .foo\r} {}\rtest cmdAH-10.15 {Tcl_FileObjCmd: rootname} {\r testsetplatform mac\r file rootname abc.def\r} abc\rtest cmdAH-10.16 {Tcl_FileObjCmd: rootname} {\r testsetplatform mac\r file rootname abc.def.ghi\r} abc.def\rtest cmdAH-10.17 {Tcl_FileObjCmd: rootname} {\r testsetplatform mac\r file rootname a:b:c.d\r} a:b:c\rtest cmdAH-10.18 {Tcl_FileObjCmd: rootname} {\r testsetplatform mac\r file rootname a:b.c:d\r} a:b.c:d\rtest cmdAH-10.19 {Tcl_FileObjCmd: rootname} {\r testsetplatform mac\r file rootname a/b/c.d\r} a/b/c\rtest cmdAH-10.20 {Tcl_FileObjCmd: rootname} {\r testsetplatform mac\r file rootname a/b.c/d\r} a/b.c/d\rtest cmdAH-10.21 {Tcl_FileObjCmd: rootname} {\r testsetplatform mac\r file rootname /a.b\r} /a\rtest cmdAH-10.22 {Tcl_FileObjCmd: rootname} {\r testsetplatform mac\r file rootname foo.c:\r} foo.c:\rtest cmdAH-10.23 {Tcl_FileObjCmd: rootname} {\r testsetplatform windows\r file rootname {}\r} {}\rtest cmdAH-10.24 {Tcl_FileObjCmd: rootname} {\r testsetplatform windows\r file ro foo\r} foo\rtest cmdAH-10.25 {Tcl_FileObjCmd: rootname} {\r testsetplatform windows\r file rootname foo.\r} foo\rtest cmdAH-10.26 {Tcl_FileObjCmd: rootname} {\r testsetplatform windows\r file rootname .foo\r} {}\rtest cmdAH-10.27 {Tcl_FileObjCmd: rootname} {\r testsetplatform windows\r file rootname abc.def\r} abc\rtest cmdAH-10.28 {Tcl_FileObjCmd: rootname} {\r testsetplatform windows\r file rootname abc.def.ghi\r} abc.def\rtest cmdAH-10.29 {Tcl_FileObjCmd: rootname} {\r testsetplatform windows\r file rootname a/b/c.d\r} a/b/c\rtest cmdAH-10.30 {Tcl_FileObjCmd: rootname} {\r testsetplatform windows\r file rootname a/b.c/d\r} a/b.c/d\rtest cmdAH-10.31 {Tcl_FileObjCmd: rootname} {\r testsetplatform windows\r file rootname a\\b.c\\\r} a\\b.c\\\rtest cmdAH-10.32 {Tcl_FileObjCmd: rootname} {\r testsetplatform windows\r file rootname a\\b\\c.d\r} a\\b\\c\rtest cmdAH-10.33 {Tcl_FileObjCmd: rootname} {\r testsetplatform windows\r file rootname a\\b.c\\d\r} a\\b.c\\d\rtest cmdAH-10.34 {Tcl_FileObjCmd: rootname} {\r testsetplatform windows\r file rootname a\\b.c\\\r} a\\b.c\\\rset num 35\rforeach outer { {} a .a a. a.a } {\r foreach inner { {} a .a a. a.a } {\r set thing [format %s/%s $outer $inner]\r; test cmdAH-6.$num {Tcl_FileObjCmd: rootname and extension options} {\r testsetplatform unix\r format %s%s [file rootname $thing] [file ext $thing]\r } $thing\r set num [expr $num+1]\r }\r}\r\r# extension\r\rtest cmdAH-11.1 {Tcl_FileObjCmd: extension} {\r testsetplatform unix\r list [catch {file extension a b} msg] $msg\r} {1 {wrong # args: should be "file extension name"}}\rtest cmdAH-11.2 {Tcl_FileObjCmd: extension} {\r testsetplatform unix\r file extension {}\r} {}\rtest cmdAH-11.3 {Tcl_FileObjCmd: extension} {\r testsetplatform unix\r file ext foo\r} {}\rtest cmdAH-11.4 {Tcl_FileObjCmd: extension} {\r testsetplatform unix\r file extension foo.\r} .\rtest cmdAH-11.5 {Tcl_FileObjCmd: extension} {\r testsetplatform unix\r file extension .foo\r} .foo\rtest cmdAH-11.6 {Tcl_FileObjCmd: extension} {\r testsetplatform unix\r file extension abc.def\r} .def\rtest cmdAH-11.7 {Tcl_FileObjCmd: extension} {\r testsetplatform unix\r file extension abc.def.ghi\r} .ghi\rtest cmdAH-11.8 {Tcl_FileObjCmd: extension} {\r testsetplatform unix\r file extension a/b/c.d\r} .d\rtest cmdAH-11.9 {Tcl_FileObjCmd: extension} {\r testsetplatform unix\r file extension a/b.c/d\r} {}\rtest cmdAH-11.10 {Tcl_FileObjCmd: extension} {\r testsetplatform unix\r file extension a/b.c/\r} {}\rtest cmdAH-11.11 {Tcl_FileObjCmd: extension} {\r testsetplatform mac\r file ext foo\r} {}\rtest cmdAH-11.12 {Tcl_FileObjCmd: extension} {\r testsetplatform mac\r file extension {}\r} {}\rtest cmdAH-11.13 {Tcl_FileObjCmd: extension} {\r testsetplatform mac\r file extension foo.\r} .\rtest cmdAH-11.14 {Tcl_FileObjCmd: extension} {\r testsetplatform mac\r file extension .foo\r} .foo\rtest cmdAH-11.15 {Tcl_FileObjCmd: extension} {\r testsetplatform mac\r file extension abc.def\r} .def\rtest cmdAH-11.16 {Tcl_FileObjCmd: extension} {\r testsetplatform mac\r file extension abc.def.ghi\r} .ghi\rtest cmdAH-11.17 {Tcl_FileObjCmd: extension} {\r testsetplatform mac\r file extension a:b:c.d\r} .d\rtest cmdAH-11.18 {Tcl_FileObjCmd: extension} {\r testsetplatform mac\r file extension a:b.c:d\r} {}\rtest cmdAH-11.19 {Tcl_FileObjCmd: extension} {\r testsetplatform mac\r file extension a/b/c.d\r} .d\rtest cmdAH-11.20 {Tcl_FileObjCmd: extension} {\r testsetplatform mac\r file extension a/b.c/d\r} {}\rtest cmdAH-11.21 {Tcl_FileObjCmd: extension} {\r testsetplatform mac\r file extension /a.b\r} .b\rtest cmdAH-11.22 {Tcl_FileObjCmd: extension} {\r testsetplatform mac\r file extension foo.c:\r} {}\rtest cmdAH-11.23 {Tcl_FileObjCmd: extension} {\r testsetplatform windows\r file extension {}\r} {}\rtest cmdAH-11.24 {Tcl_FileObjCmd: extension} {\r testsetplatform windows\r file ext foo\r} {}\rtest cmdAH-11.25 {Tcl_FileObjCmd: extension} {\r testsetplatform windows\r file extension foo.\r} .\rtest cmdAH-11.26 {Tcl_FileObjCmd: extension} {\r testsetplatform windows\r file extension .foo\r} .foo\rtest cmdAH-11.27 {Tcl_FileObjCmd: extension} {\r testsetplatform windows\r file extension abc.def\r} .def\rtest cmdAH-11.28 {Tcl_FileObjCmd: extension} {\r testsetplatform windows\r file extension abc.def.ghi\r} .ghi\rtest cmdAH-11.29 {Tcl_FileObjCmd: extension} {\r testsetplatform windows\r file extension a/b/c.d\r} .d\rtest cmdAH-11.30 {Tcl_FileObjCmd: extension} {\r testsetplatform windows\r file extension a/b.c/d\r} {}\rtest cmdAH-11.31 {Tcl_FileObjCmd: extension} {\r testsetplatform windows\r file extension a\\b.c\\\r} {}\rtest cmdAH-11.32 {Tcl_FileObjCmd: extension} {\r testsetplatform windows\r file extension a\\b\\c.d\r} .d\rtest cmdAH-11.33 {Tcl_FileObjCmd: extension} {\r testsetplatform windows\r file extension a\\b.c\\d\r} {}\rtest cmdAH-11.34 {Tcl_FileObjCmd: extension} {\r testsetplatform windows\r file extension a\\b.c\\\r} {}\rset num 35\rforeach value {a..b a...b a.c..b ..b} result {.b .b .b .b} {\r foreach p {unix mac windows} {\r; test cmdAH-7.$num {Tcl_FileObjCmd: extension} "\r testsetplatform $p\r file extension $value\r " $result\r incr num\r }\r}\r\r# pathtype\r\rtest cmdAH-12.1 {Tcl_FileObjCmd: pathtype} {\r testsetplatform unix\r list [catch {file pathtype a b} msg] $msg\r} {1 {wrong # args: should be "file pathtype name"}}\rtest cmdAH-12.2 {Tcl_FileObjCmd: pathtype} {\r testsetplatform unix\r file pathtype /a\r} absolute\rtest cmdAH-12.3 {Tcl_FileObjCmd: pathtype} {\r testsetplatform unix\r file p a\r} relative\rtest cmdAH-12.4 {Tcl_FileObjCmd: pathtype} {\r testsetplatform windows\r file pathtype c:a\r} volumerelative\r\r# split\r\rtest cmdAH-13.1 {Tcl_FileObjCmd: split} {\r testsetplatform unix\r list [catch {file split a b} msg] $msg\r} {1 {wrong # args: should be "file split name"}}\rtest cmdAH-13.2 {Tcl_FileObjCmd: split} {\r testsetplatform unix\r file split a\r} a\rtest cmdAH-13.3 {Tcl_FileObjCmd: split} {\r testsetplatform unix\r file split a/b\r} {a b}\r\r# join\r\rtest cmdAH-14.1 {Tcl_FileObjCmd: join} {\r testsetplatform unix\r file join a\r} a\rtest cmdAH-14.2 {Tcl_FileObjCmd: join} {\r testsetplatform unix\r file join a b\r} a/b\rtest cmdAH-14.3 {Tcl_FileObjCmd: join} {\r testsetplatform unix\r file join a b c d\r} a/b/c/d\r\r# error handling of Tcl_TranslateFileName\r\rtest cmdAH-15.1 {Tcl_FileObjCmd} {\r testsetplatform unix\r list [catch {file atime ~_bad_user} msg] $msg\r} {1 {user "_bad_user" doesn't exist}}\r\rtestsetplatform $platform\r}\r\r# readable\r\rmakeFile abcde gorp.file\rmakeDirectory dir.file\r\rtest cmdAH-16.1 {Tcl_FileObjCmd: readable} {testchmod} {\r list [catch {file readable a b} msg] $msg\r} {1 {wrong # args: should be "file readable name"}}\rtestchmod 444 gorp.file\rtest cmdAH-16.2 {Tcl_FileObjCmd: readable} {testchmod} {\r file readable gorp.file\r} 1\rtestchmod 333 gorp.file\rtest cmdAH-16.3 {Tcl_FileObjCmd: readable} {unixOnly notRoot testchmod} {\r file reada gorp.file\r} 0\r\r# writable\r\rtest cmdAH-17.1 {Tcl_FileObjCmd: writable} {testchmod} {\r list [catch {file writable a b} msg] $msg\r} {1 {wrong # args: should be "file writable name"}}\rtestchmod 555 gorp.file\rtest cmdAH-17.2 {Tcl_FileObjCmd: writable} {notRoot testchmod} {\r file writable gorp.file\r} 0\rtestchmod 222 gorp.file\rtest cmdAH-17.3 {Tcl_FileObjCmd: writable} {testchmod} {\r file writable gorp.file\r} 1\r\r# executable\r\rfile delete -force dir.file gorp.file\rfile mkdir dir.file\rmakeFile abcde gorp.file\r\rtest cmdAH-18.1 {Tcl_FileObjCmd: executable} {testchmod} {\r list [catch {file executable a b} msg] $msg\r} {1 {wrong # args: should be "file executable name"}}\rtest cmdAH-18.2 {Tcl_FileObjCmd: executable} {testchmod} {\r file executable gorp.file\r} 0\rtest cmdAH-18.3 {Tcl_FileObjCmd: executable} {unixOnly testchmod} {\r # Only on unix will setting the execute bit on a regular file\r # cause that file to be executable. \r \r testchmod 775 gorp.file\r file exe gorp.file\r} 1\r\rtest cmdAH-18.4 {Tcl_FileObjCmd: executable} {macOnly testchmod} {\r # On mac, the only executable files are of type APPL.\r\r set x [file exe gorp.file] \r file attrib gorp.file -type APPL\r lappend x [file exe gorp.file]\r} {0 1}\rtest cmdAH-18.5 {Tcl_FileObjCmd: executable} {pcOnly testchmod} {\r # On pc, must be a .exe, .com, etc.\r \r set x [file exe gorp.file]\r makeFile foo gorp.exe\r lappend x [file exe gorp.exe]\r file delete gorp.exe\r set x\r} {0 1}\rtest cmdAH-18.6 {Tcl_FileObjCmd: executable} {testchmod} {\r # Directories are always executable.\r \r file exe dir.file\r} 1\r\rfile delete -force dir.file \rfile delete gorp.file\rfile delete link.file\r\r# exists\r\rtest cmdAH-19.1 {Tcl_FileObjCmd: exists} {\r list [catch {file exists a b} msg] $msg\r} {1 {wrong # args: should be "file exists name"}}\rtest cmdAH-19.2 {Tcl_FileObjCmd: exists} {file exists gorp.file} 0\rtest cmdAH-19.3 {Tcl_FileObjCmd: exists} {\r file exists [file join dir.file gorp.file]\r} 0\rcatch {\r makeFile abcde gorp.file\r makeDirectory dir.file\r makeFile 12345 [file join dir.file gorp.file]\r}\rtest cmdAH-19.4 {Tcl_FileObjCmd: exists} {\r file exists gorp.file\r} 1\rtest cmdAH-19.5 {Tcl_FileObjCmd: exists} {\r file exists [file join dir.file gorp.file]\r} 1\r\r# nativename\rif {[info commands testsetplatform] == {}} {\r puts "This application hasn't been compiled with the \"testsetplatform\""\r puts "command, so I can't test Tcl_FileObjCmd etc."\r} else {\rtest cmdAH-19.6 {Tcl_FileObjCmd: nativename} {\r testsetplatform unix\r list [catch {file nativename a/b} msg] $msg [testsetplatform $platform]\r} {0 a/b {}}\rtest cmdAH-19.7 {Tcl_FileObjCmd: nativename} {\r testsetplatform windows\r list [catch {file nativename a/b} msg] $msg [testsetplatform $platform]\r} {0 {a\b} {}}\rtest cmdAH-19.8 {Tcl_FileObjCmd: nativename} {\r testsetplatform mac\r list [catch {file nativename a/b} msg] $msg [testsetplatform $platform]\r} {0 :a:b {}}\r}\r\rtest cmdAH-19.9 {Tcl_FileObjCmd: ~ : exists} {\r file exists ~nOsUcHuSeR\r} 0\rtest cmdAH-19.10 {Tcl_FileObjCmd: ~ : nativename} {\r # should probably be 0 in fact...\r catch {file nativename ~nOsUcHuSeR}\r} 1\r\r# The test below has to be done in /tmp rather than the current\r# directory in order to guarantee (?) a local file system: some\r# NFS file systems won't do the stuff below correctly.\r\rtest cmdAH-19.11 {Tcl_FileObjCmd: exists} {unixOnly notRoot} {\r removeFile /tmp/tcl.foo.dir/file\r removeDirectory /tmp/tcl.foo.dir\r makeDirectory /tmp/tcl.foo.dir\r makeFile 12345 /tmp/tcl.foo.dir/file\r exec chmod 000 /tmp/tcl.foo.dir\r\r set result [file exists /tmp/tcl.foo.dir/file]\r\r exec chmod 775 /tmp/tcl.foo.dir\r removeFile /tmp/tcl.foo.dir/file\r removeDirectory /tmp/tcl.foo.dir\r set result\r} 0\r\r# Stat related commands\r\rcatch {testsetplatform $platform}\rfile delete gorp.file\rmakeFile "Test string" gorp.file\rcatch {exec chmod 765 gorp.file}\r\r# atime\r\rset file [makeFile "data" touch.me]\r\rtest cmdAH-20.1 {Tcl_FileObjCmd: atime} {\r list [catch {file atime a b c} msg] $msg\r} {1 {wrong # args: should be "file atime name ?time?"}}\rtest cmdAH-20.2 {Tcl_FileObjCmd: atime} {\r catch {unset stat}\r file stat gorp.file stat\r list [expr {[file mtime gorp.file] == $stat(mtime)}] \\r [expr {[file atime gorp.file] == $stat(atime)}]\r} {1 1}\rtest cmdAH-20.3 {Tcl_FileObjCmd: atime} {\r string tolower [list [catch {file atime _bogus_} msg] \\r $msg $errorCode]\r} {1 {could not read "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}\rtest cmdAH-20.4 {Tcl_FileObjCmd: atime} {\r list [catch {file atime $file notint} msg] $msg\r} {1 {expected integer but got "notint"}}\rtest cmdAH-20.5 {Tcl_FileObjCmd: atime touch} {\r if {[string equal $tcl_platform(platform) "windows"]} {\r set old [pwd]\r cd $::tcltest::temporaryDirectory\r if {![string equal "NTFS" [testvolumetype]]} {\r # Windows FAT doesn't understand atime, but NTFS does\r # May also fail for Windows on NFS mounted disks\r cd $old\r return 1\r }\r cd $old\r }\r set atime [file atime $file]\r after 1100; # pause a sec to notice change in atime\r set newatime [clock seconds]\r expr {$newatime==[file atime $file $newatime]}\r} 1\r\r# isdirectory\r\rtest cmdAH-21.1 {Tcl_FileObjCmd: isdirectory} {\r list [catch {file isdirectory a b} msg] $msg\r} {1 {wrong # args: should be "file isdirectory name"}}\rtest cmdAH-21.2 {Tcl_FileObjCmd: isdirectory} {\r file isdirectory gorp.file\r} 0\rtest cmdAH-21.3 {Tcl_FileObjCmd: isdirectory} {\r file isd dir.file\r} 1\r\r# isfile\r\rtest cmdAH-22.1 {Tcl_FileObjCmd: isfile} {\r list [catch {file isfile a b} msg] $msg\r} {1 {wrong # args: should be "file isfile name"}}\rtest cmdAH-22.2 {Tcl_FileObjCmd: isfile} {file isfile gorp.file} 1\rtest cmdAH-22.3 {Tcl_FileObjCmd: isfile} {file isfile dir.file} 0\r\r# lstat and readlink: don't run these tests everywhere, since not all\r# sites will have symbolic links\r\rcatch {exec ln -s gorp.file link.file}\rtest cmdAH-23.1 {Tcl_FileObjCmd: lstat} {\r list [catch {file lstat a} msg] $msg\r} {1 {wrong # args: should be "file lstat name varName"}}\rtest cmdAH-23.2 {Tcl_FileObjCmd: lstat} {\r list [catch {file lstat a b c} msg] $msg\r} {1 {wrong # args: should be "file lstat name varName"}}\rtest cmdAH-23.3 {Tcl_FileObjCmd: lstat} {unixOnly nonPortable} {\r catch {unset stat}\r file lstat link.file stat\r lsort [array names stat]\r} {atime ctime dev gid ino mode mtime nlink size type uid}\rtest cmdAH-23.4 {Tcl_FileObjCmd: lstat} {unixOnly nonPortable} {\r catch {unset stat}\r file lstat link.file stat\r list $stat(nlink) [expr $stat(mode)&0777] $stat(type)\r} {1 511 link}\rtest cmdAH-23.5 {Tcl_FileObjCmd: lstat errors} {nonPortable} {\r string tolower [list [catch {file lstat _bogus_ stat} msg] \\r $msg $errorCode]\r} {1 {could not read "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}\rtest cmdAH-23.6 {Tcl_FileObjCmd: lstat errors} {\r catch {unset x}\r set x 44\r list [catch {file lstat gorp.file x} msg] $msg $errorCode\r} {1 {can't set "x(dev)": variable isn't array} NONE}\rcatch {unset stat}\r\r# mkdir\r\rtest cmdAH-23.7 {Tcl_FileObjCmd: mkdir} {\r catch {file delete -force a}\r file mkdir a\r set res [file isdirectory a]\r file delete a\r set res\r} {1}\rtest cmdAH-23.8 {Tcl_FileObjCmd: mkdir} {\r catch {file delete -force a}\r file mkdir a/b\r set res [file isdirectory a/b]\r file delete -force a\r set res\r} {1}\rtest cmdAH-23.9 {Tcl_FileObjCmd: mkdir} {\r catch {file delete -force a}\r file mkdir a/b/c\r set res [file isdirectory a/b/c]\r file delete -force a\r set res\r} {1}\rtest cmdAH-23.10 {Tcl_FileObjCmd: mkdir} {\r catch {file delete -force a}\r catch {file delete -force b}\r file mkdir a/b b/a/c\r set res [list [file isdirectory a/b] [file isdirectory b/a/c]]\r file delete -force a\r file delete -force b\r set res\r} {1 1}\r\r# mtime \r\rset file [makeFile "data" touch.me]\r\rtest cmdAH-24.1 {Tcl_FileObjCmd: mtime} {\r list [catch {file mtime a b c} msg] $msg\r} {1 {wrong # args: should be "file mtime name ?time?"}}\rtest cmdAH-24.2 {Tcl_FileObjCmd: mtime} {\r set old [file mtime gorp.file]\r after 2000\r set f [open gorp.file w]\r puts $f "More text"\r close $f\r set new [file mtime gorp.file]\r expr {($new > $old) && ($new <= ($old+5))}\r} {1}\rtest cmdAH-24.3 {Tcl_FileObjCmd: mtime} {\r catch {unset stat}\r file stat gorp.file stat\r list [expr {[file mtime gorp.file] == $stat(mtime)}] \\r [expr {[file atime gorp.file] == $stat(atime)}]\r} {1 1}\rtest cmdAH-24.4 {Tcl_FileObjCmd: mtime} {\r string tolower [list [catch {file mtime _bogus_} msg] $msg \\r $errorCode]\r} {1 {could not read "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}\rtest cmdAH-24.5 {Tcl_FileObjCmd: mtime} {\r # Under Unix, use a file in /tmp to avoid clock skew due to NFS.\r # On other platforms, just use a file in the local directory.\r\r if {[string equal $tcl_platform(platform) "unix"]} {\r set name /tmp/tcl.test\r } else {\r set name tf\r }\r\r # Make sure that a new file's time is correct. 10 seconds variance \r # is allowed used due to slow networks or clock skew on a network drive.\r\r file delete -force $name\r close [open $name w]\r set a [expr abs([clock seconds]-[file mtime $name])<10]\r file delete $name\r set a\r} {1}\rtest cmdAH-24.7 {Tcl_FileObjCmd: mtime} {\r list [catch {file mtime $file notint} msg] $msg\r} {1 {expected integer but got "notint"}}\rtest cmdAH-24.8 {Tcl_FileObjCmd: mtime touch} {\r set mtime [file mtime $file]\r after 1100; # pause a sec to notice change in mtime\r set newmtime [clock seconds]\r expr {$newmtime==[file mtime $file $newmtime]}\r} 1\r\r\r# owned\r\rtest cmdAH-25.1 {Tcl_FileObjCmd: owned} {\r list [catch {file owned a b} msg] $msg\r} {1 {wrong # args: should be "file owned name"}}\rtest cmdAH-25.2 {Tcl_FileObjCmd: owned} {\r file owned gorp.file\r} 1\rtest cmdAH-25.3 {Tcl_FileObjCmd: owned} {unixOnly notRoot} {\r file owned /\r} 0\r\r# readlink\r\rtest cmdAH-26.1 {Tcl_FileObjCmd: readlink} {\r list [catch {file readlink a b} msg] $msg\r} {1 {wrong # args: should be "file readlink name"}}\rtest cmdAH-26.2 {Tcl_FileObjCmd: readlink} {unixOnly nonPortable} {\r file readlink link.file\r} gorp.file\rtest cmdAH-26.3 {Tcl_FileObjCmd: readlink errors} {unixOnly nonPortable} {\r list [catch {file readlink _bogus_} msg] [string tolower $msg] \\r [string tolower $errorCode]\r} {1 {could not readlink "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}\rtest cmdAH-26.4 {Tcl_FileObjCmd: readlink errors} {macOnly nonPortable} {\r list [catch {file readlink _bogus_} msg] [string tolower $msg] \\r [string tolower $errorCode]\r} {1 {could not readlink "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}\rtest cmdAH-26.5 {Tcl_FileObjCmd: readlink errors} {pcOnly nonPortable} {\r list [catch {file readlink _bogus_} msg] [string tolower $msg] \\r [string tolower $errorCode]\r} {1 {could not readlink "_bogus_": invalid argument} {posix einval {invalid argument}}}\r\r# size\r\rtest cmdAH-27.1 {Tcl_FileObjCmd: size} {\r list [catch {file size a b} msg] $msg\r} {1 {wrong # args: should be "file size name"}}\rtest cmdAH-27.2 {Tcl_FileObjCmd: size} {\r set oldsize [file size gorp.file]\r set f [open gorp.file a]\r fconfigure $f -translation lf -eofchar {}\r puts $f "More text"\r close $f\r expr {[file size gorp.file] - $oldsize}\r} {10}\rtest cmdAH-27.3 {Tcl_FileObjCmd: size} {\r string tolower [list [catch {file size _bogus_} msg] $msg \\r $errorCode]\r} {1 {could not read "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}\r\r# stat\r\rcatch {testsetplatform $platform}\rmakeFile "Test string" gorp.file\rcatch {exec chmod 765 gorp.file}\r\rtest cmdAH-28.1 {Tcl_FileObjCmd: stat} {\r list [catch {file stat _bogus_} msg] $msg $errorCode\r} {1 {wrong # args: should be "file stat name varName"} NONE}\rtest cmdAH-28.2 {Tcl_FileObjCmd: stat} {\r list [catch {file stat _bogus_ a b} msg] $msg $errorCode\r} {1 {wrong # args: should be "file stat name varName"} NONE}\rtest cmdAH-28.3 {Tcl_FileObjCmd: stat} {\r catch {unset stat}\r file stat gorp.file stat\r lsort [array names stat]\r} {atime ctime dev gid ino mode mtime nlink size type uid}\rtest cmdAH-28.4 {Tcl_FileObjCmd: stat} {\r catch {unset stat}\r file stat gorp.file stat\r list $stat(nlink) $stat(size) $stat(type)\r} {1 12 file}\rtest cmdAH-28.5 {Tcl_FileObjCmd: stat} {unixOnly} {\r catch {unset stat}\r file stat gorp.file stat\r expr $stat(mode)&0777\r} {501}\rtest cmdAH-28.6 {Tcl_FileObjCmd: stat} {\r string tolower [list [catch {file stat _bogus_ stat} msg] \\r $msg $errorCode]\r} {1 {could not read "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}\rtest cmdAH-28.7 {Tcl_FileObjCmd: stat} {\r catch {unset x}\r set x 44\r list [catch {file stat gorp.file x} msg] $msg $errorCode\r} {1 {can't set "x(dev)": variable isn't array} NONE}\rtest cmdAH-28.8 {Tcl_FileObjCmd: stat} {\r # Sign extension of purported unsigned short to int.\r\r close [open foo.test w]\r file stat foo.test stat\r set x [expr {$stat(mode) > 0}]\r file delete foo.test\r set x\r} 1\rtest cmdAH-28.9 {Tcl_FileObjCmd: stat} {pcOnly} {\r # stat of root directory was failing.\r # don't care about answer, just that test runs.\r\r # relative paths that resolve to root\r set old [pwd]\r cd c:/\r file stat c: stat \r file stat c:. stat\r file stat . stat\r cd $old\r\r file stat / stat\r file stat c:/ stat\r file stat c:/. stat\r} {}\rtest cmdAH-28.10 {Tcl_FileObjCmd: stat} {pcOnly nonPortable} {\r # stat of root directory was failing.\r # don't care about answer, just that test runs.\r\r file stat //pop/$env(USERNAME) stat\r file stat //pop/$env(USERNAME)/ stat\r file stat //pop/$env(USERNAME)/. stat\r} {} \rtest cmdAH-28.11 {Tcl_FileObjCmd: stat} {pcOnly nonPortable} {\r # stat of network directory was returning id of current local drive.\r\r set old [pwd]\r cd c:/\r\r file stat //pop/$env(USERNAME) stat\r cd $old\r expr {$stat(dev) == 2}\r} 0\rtest cmdAH-28.12 {Tcl_FileObjCmd: stat} {\r # stat(mode) with S_IFREG flag was returned as a negative number\r # if mode_t was a short instead of an unsigned short.\r\r close [open foo.test w]\r file stat foo.test stat\r file delete foo.test\r expr {$stat(mode) > 0}\r} 1\rcatch {unset stat}\r\r# type\r\rfile delete link.file\r\rtest cmdAH-29.1 {Tcl_FileObjCmd: type} {\r list [catch {file size a b} msg] $msg\r} {1 {wrong # args: should be "file size name"}}\rtest cmdAH-29.2 {Tcl_FileObjCmd: type} {\r file type dir.file\r} directory\rtest cmdAH-29.3 {Tcl_FileObjCmd: type} {\r file type gorp.file\r} file\rtest cmdAH-29.4 {Tcl_FileObjCmd: type} {unixOnly nonPortable} {\r exec ln -s a/b/c link.file\r set result [file type link.file]\r file delete link.file\r set result\r} link\rtest cmdAH-29.5 {Tcl_FileObjCmd: type} {\r string tolower [list [catch {file type _bogus_} msg] $msg $errorCode]\r} {1 {could not read "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}\r\r# Error conditions\r\rtest cmdAH-30.1 {Tcl_FileObjCmd: error conditions} {\r list [catch {file gorp x} msg] $msg\r} {1 {bad option "gorp": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, type, volumes, or writable}}\rtest cmdAH-30.2 {Tcl_FileObjCmd: error conditions} {\r list [catch {file ex x} msg] $msg\r} {1 {ambiguous option "ex": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, type, volumes, or writable}}\rtest cmdAH-30.3 {Tcl_FileObjCmd: error conditions} {\r list [catch {file is x} msg] $msg\r} {1 {ambiguous option "is": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, type, volumes, or writable}}\rtest cmdAH-30.4 {Tcl_FileObjCmd: error conditions} {\r list [catch {file z x} msg] $msg\r} {1 {bad option "z": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, type, volumes, or writable}}\rtest cmdAH-30.5 {Tcl_FileObjCmd: error conditions} {\r list [catch {file read x} msg] $msg\r} {1 {ambiguous option "read": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, type, volumes, or writable}}\rtest cmdAH-30.6 {Tcl_FileObjCmd: error conditions} {\r list [catch {file s x} msg] $msg\r} {1 {ambiguous option "s": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, type, volumes, or writable}}\rtest cmdAH-30.7 {Tcl_FileObjCmd: error conditions} {\r list [catch {file t x} msg] $msg\r} {1 {ambiguous option "t": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, type, volumes, or writable}}\rtest cmdAH-30.8 {Tcl_FileObjCmd: error conditions} {\r list [catch {file dirname ~woohgy} msg] $msg\r} {1 {user "woohgy" doesn't exist}}\r\r# channels\r# In testing 'file channels', we need to make sure that a channel\r# created in one interp isn't visible in another.\r\rinterp create simpleInterp\rinterp create -safe safeInterp\rinterp c\rsafeInterp expose file file\r\rtest cmdAH-31.1 {Tcl_FileObjCmd: channels, too many args} {\r list [catch {file channels a b} msg] $msg\r} {1 {wrong # args: should be "file channels ?pattern?"}}\rtest cmdAH-31.2 {Tcl_FileObjCmd: channels, too many args} {\r # Normal interps start out with only the standard channels\r lsort [simpleInterp eval [list file chan]]\r} [lsort {stderr stdout stdin}]\rtest cmdAH-31.3 {Tcl_FileObjCmd: channels, globbing} {\r string equal [file channels] [file channels *]\r} {1}\rtest cmdAH-31.4 {Tcl_FileObjCmd: channels, globbing} {\r lsort [file channels std*]\r} [lsort {stdout stderr stdin}]\r\rset newFileId [open gorp.file w]\r\rtest cmdAH-31.5 {Tcl_FileObjCmd: channels} {\r set res [file channels $newFileId]\r string equal $newFileId $res\r} {1}\rtest cmdAH-31.6 {Tcl_FileObjCmd: channels in other interp} {\r # Safe interps start out with no channels\r safeInterp eval [list file channels]\r} {}\rtest cmdAH-31.7 {Tcl_FileObjCmd: channels in other interp} {\r list [catch {safeInterp eval [list puts $newFileId "hello"]} msg] $msg\r} [list 1 "can not find channel named \"$newFileId\""]\r\rinterp share {} $newFileId safeInterp\rinterp share {} stdout safeInterp\r\rtest cmdAH-31.8 {Tcl_FileObjCmd: channels in other interp} {\r # $newFileId should now be visible in both interps\r list [file channels $newFileId] \\r [safeInterp eval [list file channels $newFileId]]\r} [list $newFileId $newFileId]\rtest cmdAH-31.9 {Tcl_FileObjCmd: channels in other interp} {\r lsort [safeInterp eval [list file channels]]\r} [lsort [list stdout $newFileId]]\rtest cmdAH-31.10 {Tcl_FileObjCmd: channels in other interp} {\r # we can now write to $newFileId from slave\r safeInterp eval [list puts $newFileId "hello"]\r} {}\r\rinterp transfer {} $newFileId safeInterp\r\rtest cmdAH-31.11 {Tcl_FileObjCmd: channels in other interp} {\r # $newFileId should now be visible only in safeInterp\r list [file channels $newFileId] \\r [safeInterp eval [list file channels $newFileId]]\r} [list {} $newFileId]\rtest cmdAH-31.12 {Tcl_FileObjCmd: channels in other interp} {\r lsort [safeInterp eval [list file channels]]\r} [lsort [list stdout $newFileId]]\rtest cmdAH-31.13 {Tcl_FileObjCmd: channels in other interp} {\r safeInterp eval [list close $newFileId]\r safeInterp eval [list file channels]\r} {stdout}\r\r# This shouldn't work, but just in case a test above failed...\rcatch {close $newFileId}\r\rinterp delete safeInterp\rinterp delete simpleInterp\r\r# cleanup\rcatch {testsetplatform $platform}\rcatch {unset platform}\r\r# Tcl_ForObjCmd is tested in for.test\r\rcatch {exec chmod 777 dir.file}\rfile delete -force dir.file\rfile delete gorp.file\rfile delete link.file\r\rcd $cmdAHwd\r\r::tcltest::cleanupTests\rreturn\r\r\r\r\r\r\r\r\r\r\r\r\r\r
\ No newline at end of file
+# 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-1998 by Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
+
+tcltest::testConstraint testchmod [string equal testchmod [info commands testchmod]]
+tcltest::testConstraint fsIsWritable [expr {1 - [catch {file mkdir isreadonly ; file delete isreadonly}]}]
+
+global env
+set cmdAHwd [pwd]
+catch {set platform [testgetplatform]}
+
+test cmdAH-0.1 {Tcl_BreakObjCmd, errors} {
+ list [catch {break foo} msg] $msg
+} {1 {wrong # args: should be "break"}}
+test cmdAH-0.2 {Tcl_BreakObjCmd, success} {
+ list [catch {break} msg] $msg
+} {3 {}}
+
+# Tcl_CaseObjCmd is tested in case.test
+
+test cmdAH-1.1 {Tcl_CatchObjCmd, errors} {
+ list [catch {catch} msg] $msg
+} {1 {wrong # args: should be "catch command ?varName?"}}
+test cmdAH-1.2 {Tcl_CatchObjCmd, errors} {
+ list [catch {catch foo bar baz} msg] $msg
+} {1 {wrong # args: should be "catch command ?varName?"}}
+
+test cmdAH-2.1 {Tcl_CdObjCmd} {
+ list [catch {cd foo bar} msg] $msg
+} {1 {wrong # args: should be "cd ?dirName?"}}
+test cmdAH-2.2 {Tcl_CdObjCmd} {fsIsWritable} {
+ file delete -force foo
+ file mkdir foo
+ cd foo
+ set result [file tail [pwd]]
+ cd ..
+ file delete foo
+ set result
+} foo
+test cmdAH-2.3 {Tcl_CdObjCmd} {fsIsWritable} {
+ global env
+ set oldpwd [pwd]
+ set temp $env(HOME)
+ set env(HOME) $oldpwd
+ file delete -force foo
+ file mkdir foo
+ cd foo
+ cd ~
+ set result [string match [pwd] $oldpwd]
+ file delete foo
+ set env(HOME) $temp
+ set result
+} 1
+test cmdAH-2.4 {Tcl_CdObjCmd} {fsIsWritable} {
+ global env
+ set oldpwd [pwd]
+ set temp $env(HOME)
+ set env(HOME) $oldpwd
+ file delete -force foo
+ file mkdir foo
+ cd foo
+ cd
+ set result [string match [pwd] $oldpwd]
+ file delete foo
+ set env(HOME) $temp
+ set result
+} 1
+test cmdAH-2.5 {Tcl_CdObjCmd} {
+ list [catch {cd ~~} msg] $msg
+} {1 {user "~" doesn't exist}}
+test cmdAH-2.6 {Tcl_CdObjCmd} {
+ list [catch {cd _foobar} msg] $msg
+} {1 {couldn't change working directory to "_foobar": no such file or directory}}
+
+test cmdAH-2.7 {Tcl_ConcatObjCmd} {
+ concat
+} {}
+test cmdAH-2.8 {Tcl_ConcatObjCmd} {
+ concat a
+} a
+test cmdAH-2.9 {Tcl_ConcatObjCmd} {
+ concat a {b c}
+} {a b c}
+
+test cmdAH-3.1 {Tcl_ContinueObjCmd, errors} {
+ list [catch {continue foo} msg] $msg
+} {1 {wrong # args: should be "continue"}}
+test cmdAH-3.2 {Tcl_ContinueObjCmd, success} {
+ list [catch {continue} msg] $msg
+} {4 {}}
+
+test cmdAH-4.1 {Tcl_EncodingObjCmd} {
+ list [catch {encoding} msg] $msg
+} {1 {wrong # args: should be "encoding option ?arg ...?"}}
+test cmdAH-4.2 {Tcl_EncodingObjCmd} {
+ list [catch {encoding foo} msg] $msg
+} {1 {bad option "foo": must be convertfrom, convertto, names, or system}}
+test cmdAH-4.3 {Tcl_EncodingObjCmd} {
+ list [catch {encoding convertto} msg] $msg
+} {1 {wrong # args: should be "encoding convertto ?encoding? data"}}
+test cmdAH-4.4 {Tcl_EncodingObjCmd} {
+ list [catch {encoding convertto foo bar} msg] $msg
+} {1 {unknown encoding "foo"}}
+test cmdAH-4.5 {Tcl_EncodingObjCmd} {
+ set system [encoding system]
+ encoding system jis0208
+ set x [encoding convertto \u4e4e]
+ encoding system $system
+ set x
+} 8C
+test cmdAH-4.6 {Tcl_EncodingObjCmd} {
+ set system [encoding system]
+ encoding system identity
+ set x [encoding convertto jis0208 \u4e4e]
+ encoding system $system
+ set x
+} 8C
+test cmdAH-4.7 {Tcl_EncodingObjCmd} {
+ list [catch {encoding convertfrom} msg] $msg
+} {1 {wrong # args: should be "encoding convertfrom ?encoding? data"}}
+test cmdAH-4.8 {Tcl_EncodingObjCmd} {
+ list [catch {encoding convertfrom foo bar} msg] $msg
+} {1 {unknown encoding "foo"}}
+test cmdAH-4.9 {Tcl_EncodingObjCmd} {
+ set system [encoding system]
+ encoding system jis0208
+ set x [encoding convertfrom 8C]
+ encoding system $system
+ set x
+} \u4e4e
+test cmdAH-4.10 {Tcl_EncodingObjCmd} {
+ set system [encoding system]
+ encoding system identity
+ set x [encoding convertfrom jis0208 8C]
+ encoding system $system
+ set x
+} \u4e4e
+test cmdAH-4.11 {Tcl_EncodingObjCmd} {
+ list [catch {encoding names foo} msg] $msg
+} {1 {wrong # args: should be "encoding names"}}
+test cmdAH-4.12 {Tcl_EncodingObjCmd} {
+ list [catch {encoding system foo bar} msg] $msg
+} {1 {wrong # args: should be "encoding system ?encoding?"}}
+test cmdAH-4.13 {Tcl_EncodingObjCmd} {
+ set system [encoding system]
+ encoding system identity
+ set x [encoding system]
+ encoding system $system
+ set x
+} identity
+
+test cmdAH-5.1 {Tcl_FileObjCmd} {
+ list [catch file msg] $msg
+} {1 {wrong # args: should be "file option ?arg ...?"}}
+test cmdAH-5.2 {Tcl_FileObjCmd} {
+ list [catch {file x} msg] $msg
+} {1 {bad option "x": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, type, volumes, or writable}}
+test cmdAH-5.3 {Tcl_FileObjCmd} {
+ list [catch {file exists} msg] $msg
+} {1 {wrong # args: should be "file exists name"}}
+test cmdAH-5.4 {Tcl_FileObjCmd} {
+ list [catch {file exists ""} msg] $msg
+} {0 0}
+
+#volume
+
+test cmdAH-6.1 {Tcl_FileObjCmd: volumes} {
+ list [catch {file volumes x} msg] $msg
+} {1 {wrong # args: should be "file volumes"}}
+test cmdAH-6.2 {Tcl_FileObjCmd: volumes} {
+ set volumeList [file volumes]
+ if { [llength $volumeList] == 0 } {
+ set result 0
+ } else {
+ set result 1
+ }
+} {1}
+test cmdAH-6.3 {Tcl_FileObjCmd: volumes} {macOrUnix} {
+ set volumeList [file volumes]
+ catch [list glob -nocomplain [lindex $volumeList 0]*]
+} {0}
+test cmdAH-6.4 {Tcl_FileObjCmd: volumes} {pcOnly} {
+ set volumeList [string tolower [file volumes]]
+ list [catch {lsearch $volumeList "c:/"} element] [expr $element != -1] [catch {list glob -nocomplain [lindex $volumeList $element]*}]
+} {0 1 0}
+
+# attributes
+
+test cmdAH-7.1 {Tcl_FileObjCmd - file attrs} {fsIsWritable} {
+ catch {file delete -force foo.file}
+ close [open foo.file w]
+ list [catch {file attributes foo.file}] [file delete -force foo.file]
+} {0 {}}
+
+# dirname
+
+if {[info commands testsetplatform] == {}} {
+ puts "This application hasn't been compiled with the \"testsetplatform\""
+ puts "command, so I can't test Tcl_FileObjCmd etc."
+} else {
+test cmdAH-8.1 {Tcl_FileObjCmd: dirname} {
+ testsetplatform unix
+ list [catch {file dirname a b} msg] $msg
+} {1 {wrong # args: should be "file dirname name"}}
+test cmdAH-8.2 {Tcl_FileObjCmd: dirname} {
+ testsetplatform unix
+ file dirname /a/b
+} /a
+test cmdAH-8.3 {Tcl_FileObjCmd: dirname} {
+ testsetplatform unix
+ file dirname {}
+} .
+test cmdAH-8.4 {Tcl_FileObjCmd: dirname} {
+ testsetplatform mac
+ file dirname {}
+} :
+test cmdAH-8.5 {Tcl_FileObjCmd: dirname} {
+ testsetplatform win
+ file dirname {}
+} .
+test cmdAH-8.6 {Tcl_FileObjCmd: dirname} {
+ testsetplatform unix
+ file dirname .def
+} .
+test cmdAH-8.7 {Tcl_FileObjCmd: dirname} {
+ testsetplatform mac
+ file dirname a
+} :
+test cmdAH-8.8 {Tcl_FileObjCmd: dirname} {
+ testsetplatform win
+ file dirname a
+} .
+test cmdAH-8.9 {Tcl_FileObjCmd: dirname} {
+ testsetplatform unix
+ file dirname a/b/c.d
+} a/b
+test cmdAH-8.10 {Tcl_FileObjCmd: dirname} {
+ testsetplatform unix
+ file dirname a/b.c/d
+} a/b.c
+test cmdAH-8.11 {Tcl_FileObjCmd: dirname} {
+ testsetplatform unix
+ file dirname /.
+} /
+test cmdAH-8.12 {Tcl_FileObjCmd: dirname} {
+ testsetplatform unix
+ list [catch {file dirname /} msg] $msg
+} {0 /}
+test cmdAH-8.13 {Tcl_FileObjCmd: dirname} {
+ testsetplatform unix
+ list [catch {file dirname /foo} msg] $msg
+} {0 /}
+test cmdAH-8.14 {Tcl_FileObjCmd: dirname} {
+ testsetplatform unix
+ list [catch {file dirname //foo} msg] $msg
+} {0 /}
+test cmdAH-8.15 {Tcl_FileObjCmd: dirname} {
+ testsetplatform unix
+ list [catch {file dirname //foo/bar} msg] $msg
+} {0 /foo}
+test cmdAH-8.16 {Tcl_FileObjCmd: dirname} {
+ testsetplatform unix
+ list [catch {file dirname {//foo\/bar/baz}} msg] $msg
+} {0 {/foo\/bar}}
+test cmdAH-8.17 {Tcl_FileObjCmd: dirname} {
+ testsetplatform unix
+ list [catch {file dirname {//foo\/bar/baz/blat}} msg] $msg
+} {0 {/foo\/bar/baz}}
+test cmdAH-8.18 {Tcl_FileObjCmd: dirname} {
+ testsetplatform unix
+ list [catch {file dirname /foo//} msg] $msg
+} {0 /}
+test cmdAH-8.19 {Tcl_FileObjCmd: dirname} {
+ testsetplatform unix
+ list [catch {file dirname ./a} msg] $msg
+} {0 .}
+test cmdAH-8.20 {Tcl_FileObjCmd: dirname} {
+ testsetplatform unix
+ list [catch {file dirname a/.a} msg] $msg
+} {0 a}
+test cmdAH-8.21 {Tcl_FileObjCmd: dirname} {
+ testsetplatform windows
+ list [catch {file dirname c:foo} msg] $msg
+} {0 c:}
+test cmdAH-8.22 {Tcl_FileObjCmd: dirname} {
+ testsetplatform windows
+ list [catch {file dirname c:} msg] $msg
+} {0 c:}
+test cmdAH-8.23 {Tcl_FileObjCmd: dirname} {
+ testsetplatform windows
+ list [catch {file dirname c:/} msg] $msg
+} {0 c:/}
+test cmdAH-8.24 {Tcl_FileObjCmd: dirname} {
+ testsetplatform windows
+ list [catch {file dirname {c:\foo}} msg] $msg
+} {0 c:/}
+test cmdAH-8.25 {Tcl_FileObjCmd: dirname} {
+ testsetplatform windows
+ list [catch {file dirname {//foo/bar/baz}} msg] $msg
+} {0 //foo/bar}
+test cmdAH-8.26 {Tcl_FileObjCmd: dirname} {
+ testsetplatform windows
+ list [catch {file dirname {//foo/bar}} msg] $msg
+} {0 //foo/bar}
+test cmdAH-8.27 {Tcl_FileObjCmd: dirname} {
+ testsetplatform mac
+ list [catch {file dirname :} msg] $msg
+} {0 :}
+test cmdAH-8.28 {Tcl_FileObjCmd: dirname} {
+ testsetplatform mac
+ list [catch {file dirname :Foo} msg] $msg
+} {0 :}
+test cmdAH-8.29 {Tcl_FileObjCmd: dirname} {
+ testsetplatform mac
+ list [catch {file dirname Foo:} msg] $msg
+} {0 Foo:}
+test cmdAH-8.30 {Tcl_FileObjCmd: dirname} {
+ testsetplatform mac
+ list [catch {file dirname Foo:bar} msg] $msg
+} {0 Foo:}
+test cmdAH-8.31 {Tcl_FileObjCmd: dirname} {
+ testsetplatform mac
+ list [catch {file dirname :Foo:bar} msg] $msg
+} {0 :Foo}
+test cmdAH-8.32 {Tcl_FileObjCmd: dirname} {
+ testsetplatform mac
+ list [catch {file dirname ::} msg] $msg
+} {0 :}
+test cmdAH-8.33 {Tcl_FileObjCmd: dirname} {
+ testsetplatform mac
+ list [catch {file dirname :::} msg] $msg
+} {0 ::}
+test cmdAH-8.34 {Tcl_FileObjCmd: dirname} {
+ testsetplatform mac
+ list [catch {file dirname /foo/bar/} msg] $msg
+} {0 foo:}
+test cmdAH-8.35 {Tcl_FileObjCmd: dirname} {
+ testsetplatform mac
+ list [catch {file dirname /foo/bar} msg] $msg
+} {0 foo:}
+test cmdAH-8.36 {Tcl_FileObjCmd: dirname} {
+ testsetplatform mac
+ list [catch {file dirname /foo} msg] $msg
+} {0 foo:}
+test cmdAH-8.37 {Tcl_FileObjCmd: dirname} {
+ testsetplatform mac
+ list [catch {file dirname foo} msg] $msg
+} {0 :}
+test cmdAH-8.38 {Tcl_FileObjCmd: dirname} {
+ testsetplatform unix
+ list [catch {file dirname ~/foo} msg] $msg
+} {0 ~}
+test cmdAH-8.39 {Tcl_FileObjCmd: dirname} {
+ testsetplatform unix
+ list [catch {file dirname ~bar/foo} msg] $msg
+} {0 ~bar}
+test cmdAH-8.40 {Tcl_FileObjCmd: dirname} {
+ testsetplatform mac
+ list [catch {file dirname ~bar/foo} msg] $msg
+} {0 ~bar:}
+test cmdAH-8.41 {Tcl_FileObjCmd: dirname} {
+ testsetplatform mac
+ list [catch {file dirname ~/foo} msg] $msg
+} {0 ~:}
+test cmdAH-8.42 {Tcl_FileObjCmd: dirname} {
+ testsetplatform mac
+ list [catch {file dirname ~:baz} msg] $msg
+} {0 ~:}
+test cmdAH-8.43 {Tcl_FileObjCmd: dirname} {
+ 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-8.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-8.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-8.46 {Tcl_FileObjCmd: dirname} {
+ global env
+ set temp $env(HOME)
+ set env(HOME) "/home/test"
+ testsetplatform mac
+ set result [list [catch {file dirname ~} msg] $msg]
+ set env(HOME) $temp
+ set result
+} {0 home:}
+
+# tail
+
+test cmdAH-9.1 {Tcl_FileObjCmd: tail} {
+ testsetplatform unix
+ list [catch {file tail a b} msg] $msg
+} {1 {wrong # args: should be "file tail name"}}
+test cmdAH-9.2 {Tcl_FileObjCmd: tail} {
+ testsetplatform unix
+ file tail /a/b
+} b
+test cmdAH-9.3 {Tcl_FileObjCmd: tail} {
+ testsetplatform unix
+ file tail {}
+} {}
+test cmdAH-9.4 {Tcl_FileObjCmd: tail} {
+ testsetplatform mac
+ file tail {}
+} {}
+test cmdAH-9.5 {Tcl_FileObjCmd: tail} {
+ testsetplatform win
+ file tail {}
+} {}
+test cmdAH-9.6 {Tcl_FileObjCmd: tail} {
+ testsetplatform unix
+ file tail .def
+} .def
+test cmdAH-9.7 {Tcl_FileObjCmd: tail} {
+ testsetplatform mac
+ file tail a
+} a
+test cmdAH-9.8 {Tcl_FileObjCmd: tail} {
+ testsetplatform win
+ file tail a
+} a
+test cmdAH-9.9 {Tcl_FileObjCmd: tail} {
+ testsetplatform unix
+ file ta a/b/c.d
+} c.d
+test cmdAH-9.10 {Tcl_FileObjCmd: tail} {
+ testsetplatform unix
+ file tail a/b.c/d
+} d
+test cmdAH-9.11 {Tcl_FileObjCmd: tail} {
+ testsetplatform unix
+ file tail /.
+} .
+test cmdAH-9.12 {Tcl_FileObjCmd: tail} {
+ testsetplatform unix
+ file tail /
+} {}
+test cmdAH-9.13 {Tcl_FileObjCmd: tail} {
+ testsetplatform unix
+ file tail /foo
+} foo
+test cmdAH-9.14 {Tcl_FileObjCmd: tail} {
+ testsetplatform unix
+ file tail //foo
+} foo
+test cmdAH-9.15 {Tcl_FileObjCmd: tail} {
+ testsetplatform unix
+ file tail //foo/bar
+} bar
+test cmdAH-9.16 {Tcl_FileObjCmd: tail} {
+ testsetplatform unix
+ file tail {//foo\/bar/baz}
+} baz
+test cmdAH-9.17 {Tcl_FileObjCmd: tail} {
+ testsetplatform unix
+ file tail {//foo\/bar/baz/blat}
+} blat
+test cmdAH-9.18 {Tcl_FileObjCmd: tail} {
+ testsetplatform unix
+ file tail /foo//
+} foo
+test cmdAH-9.19 {Tcl_FileObjCmd: tail} {
+ testsetplatform unix
+ file tail ./a
+} a
+test cmdAH-9.20 {Tcl_FileObjCmd: tail} {
+ testsetplatform unix
+ file tail a/.a
+} .a
+test cmdAH-9.21 {Tcl_FileObjCmd: tail} {
+ testsetplatform windows
+ file tail c:foo
+} foo
+test cmdAH-9.22 {Tcl_FileObjCmd: tail} {
+ testsetplatform windows
+ file tail c:
+} {}
+test cmdAH-9.23 {Tcl_FileObjCmd: tail} {
+ testsetplatform windows
+ file tail c:/
+} {}
+test cmdAH-9.24 {Tcl_FileObjCmd: tail} {
+ testsetplatform windows
+ file tail {c:\foo}
+} foo
+test cmdAH-9.25 {Tcl_FileObjCmd: tail} {
+ testsetplatform windows
+ file tail {//foo/bar/baz}
+} baz
+test cmdAH-9.26 {Tcl_FileObjCmd: tail} {
+ testsetplatform windows
+ file tail {//foo/bar}
+} {}
+test cmdAH-9.27 {Tcl_FileObjCmd: tail} {
+ testsetplatform mac
+ file tail :
+} :
+test cmdAH-9.28 {Tcl_FileObjCmd: tail} {
+ testsetplatform mac
+ file tail :Foo
+} Foo
+test cmdAH-9.29 {Tcl_FileObjCmd: tail} {
+ testsetplatform mac
+ file tail Foo:
+} {}
+test cmdAH-9.30 {Tcl_FileObjCmd: tail} {
+ testsetplatform mac
+ file tail Foo:bar
+} bar
+test cmdAH-9.31 {Tcl_FileObjCmd: tail} {
+ testsetplatform mac
+ file tail :Foo:bar
+} bar
+test cmdAH-9.32 {Tcl_FileObjCmd: tail} {
+ testsetplatform mac
+ file tail ::
+} ::
+test cmdAH-9.33 {Tcl_FileObjCmd: tail} {
+ testsetplatform mac
+ file tail :::
+} ::
+test cmdAH-9.34 {Tcl_FileObjCmd: tail} {
+ testsetplatform mac
+ file tail /foo/bar/
+} bar
+test cmdAH-9.35 {Tcl_FileObjCmd: tail} {
+ testsetplatform mac
+ file tail /foo/bar
+} bar
+test cmdAH-9.36 {Tcl_FileObjCmd: tail} {
+ testsetplatform mac
+ file tail /foo
+} {}
+test cmdAH-9.37 {Tcl_FileObjCmd: tail} {
+ testsetplatform mac
+ file tail foo
+} foo
+test cmdAH-9.38 {Tcl_FileObjCmd: tail} {
+ testsetplatform mac
+ file tail ~:foo
+} foo
+test cmdAH-9.39 {Tcl_FileObjCmd: tail} {
+ testsetplatform mac
+ file tail ~bar:foo
+} foo
+test cmdAH-9.40 {Tcl_FileObjCmd: tail} {
+ testsetplatform mac
+ file tail ~bar/foo
+} foo
+test cmdAH-9.41 {Tcl_FileObjCmd: tail} {
+ testsetplatform mac
+ file tail ~/foo
+} foo
+test cmdAH-9.42 {Tcl_FileObjCmd: tail} {
+ 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-9.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-9.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-9.45 {Tcl_FileObjCmd: tail} {
+ global env
+ set temp $env(HOME)
+ set env(HOME) "/home/test"
+ testsetplatform mac
+ set result [file tail ~]
+ set env(HOME) $temp
+ set result
+} test
+test cmdAH-9.46 {Tcl_FileObjCmd: tail} {
+ testsetplatform unix
+ file tail {f.oo\bar/baz.bat}
+} baz.bat
+test cmdAH-9.47 {Tcl_FileObjCmd: tail} {
+ testsetplatform windows
+ file tail c:foo
+} foo
+test cmdAH-9.48 {Tcl_FileObjCmd: tail} {
+ testsetplatform windows
+ file tail c:
+} {}
+test cmdAH-9.49 {Tcl_FileObjCmd: tail} {
+ testsetplatform windows
+ file tail c:/foo
+} foo
+test cmdAH-9.50 {Tcl_FileObjCmd: tail} {
+ testsetplatform windows
+ file tail {c:/foo\bar}
+} bar
+test cmdAH-9.51 {Tcl_FileObjCmd: tail} {
+ testsetplatform windows
+ file tail {foo\bar}
+} bar
+
+# rootname
+
+test cmdAH-10.1 {Tcl_FileObjCmd: rootname} {
+ testsetplatform unix
+ list [catch {file rootname a b} msg] $msg
+} {1 {wrong # args: should be "file rootname name"}}
+test cmdAH-10.2 {Tcl_FileObjCmd: rootname} {
+ testsetplatform unix
+ file rootname {}
+} {}
+test cmdAH-10.3 {Tcl_FileObjCmd: rootname} {
+ testsetplatform unix
+ file ro foo
+} foo
+test cmdAH-10.4 {Tcl_FileObjCmd: rootname} {
+ testsetplatform unix
+ file rootname foo.
+} foo
+test cmdAH-10.5 {Tcl_FileObjCmd: rootname} {
+ testsetplatform unix
+ file rootname .foo
+} {}
+test cmdAH-10.6 {Tcl_FileObjCmd: rootname} {
+ testsetplatform unix
+ file rootname abc.def
+} abc
+test cmdAH-10.7 {Tcl_FileObjCmd: rootname} {
+ testsetplatform unix
+ file rootname abc.def.ghi
+} abc.def
+test cmdAH-10.8 {Tcl_FileObjCmd: rootname} {
+ testsetplatform unix
+ file rootname a/b/c.d
+} a/b/c
+test cmdAH-10.9 {Tcl_FileObjCmd: rootname} {
+ testsetplatform unix
+ file rootname a/b.c/d
+} a/b.c/d
+test cmdAH-10.10 {Tcl_FileObjCmd: rootname} {
+ testsetplatform unix
+ file rootname a/b.c/
+} a/b.c/
+test cmdAH-10.11 {Tcl_FileObjCmd: rootname} {
+ testsetplatform mac
+ file ro foo
+} foo
+test cmdAH-10.12 {Tcl_FileObjCmd: rootname} {
+ testsetplatform mac
+ file rootname {}
+} {}
+test cmdAH-10.13 {Tcl_FileObjCmd: rootname} {
+ testsetplatform mac
+ file rootname foo.
+} foo
+test cmdAH-10.14 {Tcl_FileObjCmd: rootname} {
+ testsetplatform mac
+ file rootname .foo
+} {}
+test cmdAH-10.15 {Tcl_FileObjCmd: rootname} {
+ testsetplatform mac
+ file rootname abc.def
+} abc
+test cmdAH-10.16 {Tcl_FileObjCmd: rootname} {
+ testsetplatform mac
+ file rootname abc.def.ghi
+} abc.def
+test cmdAH-10.17 {Tcl_FileObjCmd: rootname} {
+ testsetplatform mac
+ file rootname a:b:c.d
+} a:b:c
+test cmdAH-10.18 {Tcl_FileObjCmd: rootname} {
+ testsetplatform mac
+ file rootname a:b.c:d
+} a:b.c:d
+test cmdAH-10.19 {Tcl_FileObjCmd: rootname} {
+ testsetplatform mac
+ file rootname a/b/c.d
+} a/b/c
+test cmdAH-10.20 {Tcl_FileObjCmd: rootname} {
+ testsetplatform mac
+ file rootname a/b.c/d
+} a/b.c/d
+test cmdAH-10.21 {Tcl_FileObjCmd: rootname} {
+ testsetplatform mac
+ file rootname /a.b
+} /a
+test cmdAH-10.22 {Tcl_FileObjCmd: rootname} {
+ testsetplatform mac
+ file rootname foo.c:
+} foo.c:
+test cmdAH-10.23 {Tcl_FileObjCmd: rootname} {
+ testsetplatform windows
+ file rootname {}
+} {}
+test cmdAH-10.24 {Tcl_FileObjCmd: rootname} {
+ testsetplatform windows
+ file ro foo
+} foo
+test cmdAH-10.25 {Tcl_FileObjCmd: rootname} {
+ testsetplatform windows
+ file rootname foo.
+} foo
+test cmdAH-10.26 {Tcl_FileObjCmd: rootname} {
+ testsetplatform windows
+ file rootname .foo
+} {}
+test cmdAH-10.27 {Tcl_FileObjCmd: rootname} {
+ testsetplatform windows
+ file rootname abc.def
+} abc
+test cmdAH-10.28 {Tcl_FileObjCmd: rootname} {
+ testsetplatform windows
+ file rootname abc.def.ghi
+} abc.def
+test cmdAH-10.29 {Tcl_FileObjCmd: rootname} {
+ testsetplatform windows
+ file rootname a/b/c.d
+} a/b/c
+test cmdAH-10.30 {Tcl_FileObjCmd: rootname} {
+ testsetplatform windows
+ file rootname a/b.c/d
+} a/b.c/d
+test cmdAH-10.31 {Tcl_FileObjCmd: rootname} {
+ testsetplatform windows
+ file rootname a\\b.c\\
+} a\\b.c\\
+test cmdAH-10.32 {Tcl_FileObjCmd: rootname} {
+ testsetplatform windows
+ file rootname a\\b\\c.d
+} a\\b\\c
+test cmdAH-10.33 {Tcl_FileObjCmd: rootname} {
+ testsetplatform windows
+ file rootname a\\b.c\\d
+} a\\b.c\\d
+test cmdAH-10.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-11.1 {Tcl_FileObjCmd: extension} {
+ testsetplatform unix
+ list [catch {file extension a b} msg] $msg
+} {1 {wrong # args: should be "file extension name"}}
+test cmdAH-11.2 {Tcl_FileObjCmd: extension} {
+ testsetplatform unix
+ file extension {}
+} {}
+test cmdAH-11.3 {Tcl_FileObjCmd: extension} {
+ testsetplatform unix
+ file ext foo
+} {}
+test cmdAH-11.4 {Tcl_FileObjCmd: extension} {
+ testsetplatform unix
+ file extension foo.
+} .
+test cmdAH-11.5 {Tcl_FileObjCmd: extension} {
+ testsetplatform unix
+ file extension .foo
+} .foo
+test cmdAH-11.6 {Tcl_FileObjCmd: extension} {
+ testsetplatform unix
+ file extension abc.def
+} .def
+test cmdAH-11.7 {Tcl_FileObjCmd: extension} {
+ testsetplatform unix
+ file extension abc.def.ghi
+} .ghi
+test cmdAH-11.8 {Tcl_FileObjCmd: extension} {
+ testsetplatform unix
+ file extension a/b/c.d
+} .d
+test cmdAH-11.9 {Tcl_FileObjCmd: extension} {
+ testsetplatform unix
+ file extension a/b.c/d
+} {}
+test cmdAH-11.10 {Tcl_FileObjCmd: extension} {
+ testsetplatform unix
+ file extension a/b.c/
+} {}
+test cmdAH-11.11 {Tcl_FileObjCmd: extension} {
+ testsetplatform mac
+ file ext foo
+} {}
+test cmdAH-11.12 {Tcl_FileObjCmd: extension} {
+ testsetplatform mac
+ file extension {}
+} {}
+test cmdAH-11.13 {Tcl_FileObjCmd: extension} {
+ testsetplatform mac
+ file extension foo.
+} .
+test cmdAH-11.14 {Tcl_FileObjCmd: extension} {
+ testsetplatform mac
+ file extension .foo
+} .foo
+test cmdAH-11.15 {Tcl_FileObjCmd: extension} {
+ testsetplatform mac
+ file extension abc.def
+} .def
+test cmdAH-11.16 {Tcl_FileObjCmd: extension} {
+ testsetplatform mac
+ file extension abc.def.ghi
+} .ghi
+test cmdAH-11.17 {Tcl_FileObjCmd: extension} {
+ testsetplatform mac
+ file extension a:b:c.d
+} .d
+test cmdAH-11.18 {Tcl_FileObjCmd: extension} {
+ testsetplatform mac
+ file extension a:b.c:d
+} {}
+test cmdAH-11.19 {Tcl_FileObjCmd: extension} {
+ testsetplatform mac
+ file extension a/b/c.d
+} .d
+test cmdAH-11.20 {Tcl_FileObjCmd: extension} {
+ testsetplatform mac
+ file extension a/b.c/d
+} {}
+test cmdAH-11.21 {Tcl_FileObjCmd: extension} {
+ testsetplatform mac
+ file extension /a.b
+} .b
+test cmdAH-11.22 {Tcl_FileObjCmd: extension} {
+ testsetplatform mac
+ file extension foo.c:
+} {}
+test cmdAH-11.23 {Tcl_FileObjCmd: extension} {
+ testsetplatform windows
+ file extension {}
+} {}
+test cmdAH-11.24 {Tcl_FileObjCmd: extension} {
+ testsetplatform windows
+ file ext foo
+} {}
+test cmdAH-11.25 {Tcl_FileObjCmd: extension} {
+ testsetplatform windows
+ file extension foo.
+} .
+test cmdAH-11.26 {Tcl_FileObjCmd: extension} {
+ testsetplatform windows
+ file extension .foo
+} .foo
+test cmdAH-11.27 {Tcl_FileObjCmd: extension} {
+ testsetplatform windows
+ file extension abc.def
+} .def
+test cmdAH-11.28 {Tcl_FileObjCmd: extension} {
+ testsetplatform windows
+ file extension abc.def.ghi
+} .ghi
+test cmdAH-11.29 {Tcl_FileObjCmd: extension} {
+ testsetplatform windows
+ file extension a/b/c.d
+} .d
+test cmdAH-11.30 {Tcl_FileObjCmd: extension} {
+ testsetplatform windows
+ file extension a/b.c/d
+} {}
+test cmdAH-11.31 {Tcl_FileObjCmd: extension} {
+ testsetplatform windows
+ file extension a\\b.c\\
+} {}
+test cmdAH-11.32 {Tcl_FileObjCmd: extension} {
+ testsetplatform windows
+ file extension a\\b\\c.d
+} .d
+test cmdAH-11.33 {Tcl_FileObjCmd: extension} {
+ testsetplatform windows
+ file extension a\\b.c\\d
+} {}
+test cmdAH-11.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-12.1 {Tcl_FileObjCmd: pathtype} {
+ testsetplatform unix
+ list [catch {file pathtype a b} msg] $msg
+} {1 {wrong # args: should be "file pathtype name"}}
+test cmdAH-12.2 {Tcl_FileObjCmd: pathtype} {
+ testsetplatform unix
+ file pathtype /a
+} absolute
+test cmdAH-12.3 {Tcl_FileObjCmd: pathtype} {
+ testsetplatform unix
+ file p a
+} relative
+test cmdAH-12.4 {Tcl_FileObjCmd: pathtype} {
+ testsetplatform windows
+ file pathtype c:a
+} volumerelative
+
+# split
+
+test cmdAH-13.1 {Tcl_FileObjCmd: split} {
+ testsetplatform unix
+ list [catch {file split a b} msg] $msg
+} {1 {wrong # args: should be "file split name"}}
+test cmdAH-13.2 {Tcl_FileObjCmd: split} {
+ testsetplatform unix
+ file split a
+} a
+test cmdAH-13.3 {Tcl_FileObjCmd: split} {
+ testsetplatform unix
+ file split a/b
+} {a b}
+
+# join
+
+test cmdAH-14.1 {Tcl_FileObjCmd: join} {
+ testsetplatform unix
+ file join a
+} a
+test cmdAH-14.2 {Tcl_FileObjCmd: join} {
+ testsetplatform unix
+ file join a b
+} a/b
+test cmdAH-14.3 {Tcl_FileObjCmd: join} {
+ testsetplatform unix
+ file join a b c d
+} a/b/c/d
+
+# error handling of Tcl_TranslateFileName
+
+test cmdAH-15.1 {Tcl_FileObjCmd} {
+ testsetplatform unix
+ list [catch {file atime ~_bad_user} msg] $msg
+} {1 {user "_bad_user" doesn't exist}}
+
+testsetplatform $platform
+}
+
+# readable
+
+catch {
+ makeFile abcde gorp.file
+ makeDirectory dir.file
+}
+
+test cmdAH-16.1 {Tcl_FileObjCmd: readable} {testchmod fsIsWritable} {
+ list [catch {file readable a b} msg] $msg
+} {1 {wrong # args: should be "file readable name"}}
+catch {testchmod 444 gorp.file}
+test cmdAH-16.2 {Tcl_FileObjCmd: readable} {testchmod fsIsWritable} {
+ file readable gorp.file
+} 1
+catch {testchmod 333 gorp.file}
+test cmdAH-16.3 {Tcl_FileObjCmd: readable} {unixOnly notRoot testchmod fsIsWritable} {
+ file reada gorp.file
+} 0
+
+# writable
+
+test cmdAH-17.1 {Tcl_FileObjCmd: writable} {testchmod} {
+ list [catch {file writable a b} msg] $msg
+} {1 {wrong # args: should be "file writable name"}}
+testchmod 555 gorp.file
+test cmdAH-17.2 {Tcl_FileObjCmd: writable} {notRoot testchmod fsIsWritable} {
+ file writable gorp.file
+} 0
+testchmod 222 gorp.file
+test cmdAH-17.3 {Tcl_FileObjCmd: writable} {testchmod fsIsWritable} {
+ file writable gorp.file
+} 1
+
+# executable
+
+catch {
+ file delete -force dir.file gorp.file
+ file mkdir dir.file
+ makeFile abcde gorp.file
+}
+
+test cmdAH-18.1 {Tcl_FileObjCmd: executable} {testchmod} {
+ list [catch {file executable a b} msg] $msg
+} {1 {wrong # args: should be "file executable name"}}
+test cmdAH-18.2 {Tcl_FileObjCmd: executable} {testchmod fsIsWritable} {
+ file executable gorp.file
+} 0
+test cmdAH-18.3 {Tcl_FileObjCmd: executable} {unixOnly testchmod fsIsWritable} {
+ # 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-18.4 {Tcl_FileObjCmd: executable} {macOnly testchmod} {
+ # 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-18.5 {Tcl_FileObjCmd: executable} {pcOnly testchmod} {
+ # 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-18.6 {Tcl_FileObjCmd: executable} {testchmod} {
+ # 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-19.1 {Tcl_FileObjCmd: exists} {
+ list [catch {file exists a b} msg] $msg
+} {1 {wrong # args: should be "file exists name"}}
+test cmdAH-19.2 {Tcl_FileObjCmd: exists} {file exists gorp.file} 0
+test cmdAH-19.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-19.4 {Tcl_FileObjCmd: exists} {
+ file exists gorp.file
+} 1
+test cmdAH-19.5 {Tcl_FileObjCmd: exists} {
+ file exists [file join dir.file gorp.file]
+} 1
+
+# nativename
+if {[info commands testsetplatform] == {}} {
+ puts "This application hasn't been compiled with the \"testsetplatform\""
+ puts "command, so I can't test Tcl_FileObjCmd etc."
+} else {
+test cmdAH-19.6 {Tcl_FileObjCmd: nativename} {
+ testsetplatform unix
+ list [catch {file nativename a/b} msg] $msg [testsetplatform $platform]
+} {0 a/b {}}
+test cmdAH-19.7 {Tcl_FileObjCmd: nativename} {
+ testsetplatform windows
+ list [catch {file nativename a/b} msg] $msg [testsetplatform $platform]
+} {0 {a\b} {}}
+test cmdAH-19.8 {Tcl_FileObjCmd: nativename} {
+ testsetplatform mac
+ list [catch {file nativename a/b} msg] $msg [testsetplatform $platform]
+} {0 :a:b {}}
+}
+
+test cmdAH-19.9 {Tcl_FileObjCmd: ~ : exists} {
+ file exists ~nOsUcHuSeR
+} 0
+test cmdAH-19.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.
+
+test cmdAH-19.11 {Tcl_FileObjCmd: exists} {unixOnly notRoot} {
+ 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
+
+ set result [file exists /tmp/tcl.foo.dir/file]
+
+ exec chmod 775 /tmp/tcl.foo.dir
+ removeFile /tmp/tcl.foo.dir/file
+ removeDirectory /tmp/tcl.foo.dir
+ set result
+} 0
+
+# Stat related commands
+
+catch {testsetplatform $platform}
+file delete gorp.file
+makeFile "Test string" gorp.file
+catch {exec chmod 765 gorp.file}
+
+# atime
+
+set file [makeFile "data" touch.me]
+
+test cmdAH-20.1 {Tcl_FileObjCmd: atime} {
+ list [catch {file atime a b c} msg] $msg
+} {1 {wrong # args: should be "file atime name ?time?"}}
+test cmdAH-20.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-20.3 {Tcl_FileObjCmd: atime} {
+ string tolower [list [catch {file atime _bogus_} msg] \
+ $msg $errorCode]
+} {1 {could not read "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
+test cmdAH-20.4 {Tcl_FileObjCmd: atime} {
+ list [catch {file atime $file notint} msg] $msg
+} {1 {expected integer but got "notint"}}
+test cmdAH-20.5 {Tcl_FileObjCmd: atime touch} {
+ if {[string equal $tcl_platform(platform) "windows"]} {
+ set old [pwd]
+ cd $::tcltest::temporaryDirectory
+ if {![string equal "NTFS" [testvolumetype]]} {
+ # Windows FAT doesn't understand atime, but NTFS does
+ # May also fail for Windows on NFS mounted disks
+ cd $old
+ return 1
+ }
+ cd $old
+ }
+ set atime [file atime $file]
+ after 1100; # pause a sec to notice change in atime
+ set newatime [clock seconds]
+ expr {$newatime==[file atime $file $newatime]}
+} 1
+
+# isdirectory
+
+test cmdAH-21.1 {Tcl_FileObjCmd: isdirectory} {
+ list [catch {file isdirectory a b} msg] $msg
+} {1 {wrong # args: should be "file isdirectory name"}}
+test cmdAH-21.2 {Tcl_FileObjCmd: isdirectory} {
+ file isdirectory gorp.file
+} 0
+test cmdAH-21.3 {Tcl_FileObjCmd: isdirectory} {
+ file isd dir.file
+} 1
+
+# isfile
+
+test cmdAH-22.1 {Tcl_FileObjCmd: isfile} {
+ list [catch {file isfile a b} msg] $msg
+} {1 {wrong # args: should be "file isfile name"}}
+test cmdAH-22.2 {Tcl_FileObjCmd: isfile} {file isfile gorp.file} 1
+test cmdAH-22.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-23.1 {Tcl_FileObjCmd: lstat} {
+ list [catch {file lstat a} msg] $msg
+} {1 {wrong # args: should be "file lstat name varName"}}
+test cmdAH-23.2 {Tcl_FileObjCmd: lstat} {
+ list [catch {file lstat a b c} msg] $msg
+} {1 {wrong # args: should be "file lstat name varName"}}
+test cmdAH-23.3 {Tcl_FileObjCmd: lstat} {unixOnly nonPortable} {
+ 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-23.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-23.5 {Tcl_FileObjCmd: lstat errors} {nonPortable} {
+ string tolower [list [catch {file lstat _bogus_ stat} msg] \
+ $msg $errorCode]
+} {1 {could not read "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
+test cmdAH-23.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}
+
+# mkdir
+
+test cmdAH-23.7 {Tcl_FileObjCmd: mkdir} {
+ catch {file delete -force a}
+ file mkdir a
+ set res [file isdirectory a]
+ file delete a
+ set res
+} {1}
+test cmdAH-23.8 {Tcl_FileObjCmd: mkdir} {
+ catch {file delete -force a}
+ file mkdir a/b
+ set res [file isdirectory a/b]
+ file delete -force a
+ set res
+} {1}
+test cmdAH-23.9 {Tcl_FileObjCmd: mkdir} {
+ catch {file delete -force a}
+ file mkdir a/b/c
+ set res [file isdirectory a/b/c]
+ file delete -force a
+ set res
+} {1}
+test cmdAH-23.10 {Tcl_FileObjCmd: mkdir} {
+ catch {file delete -force a}
+ catch {file delete -force b}
+ file mkdir a/b b/a/c
+ set res [list [file isdirectory a/b] [file isdirectory b/a/c]]
+ file delete -force a
+ file delete -force b
+ set res
+} {1 1}
+
+# mtime
+
+set file [makeFile "data" touch.me]
+
+test cmdAH-24.1 {Tcl_FileObjCmd: mtime} {
+ list [catch {file mtime a b c} msg] $msg
+} {1 {wrong # args: should be "file mtime name ?time?"}}
+test cmdAH-24.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-24.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-24.4 {Tcl_FileObjCmd: mtime} {
+ string tolower [list [catch {file mtime _bogus_} msg] $msg \
+ $errorCode]
+} {1 {could not read "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
+test cmdAH-24.5 {Tcl_FileObjCmd: mtime} {
+ # Under Unix, use a file in /tmp to avoid clock skew due to NFS.
+ # On other platforms, just use a file in the local directory.
+
+ if {[string equal $tcl_platform(platform) "unix"]} {
+ set name /tmp/tcl.test
+ } else {
+ set name tf
+ }
+
+ # Make sure that a new file's time is correct. 10 seconds variance
+ # is allowed used due to slow networks or clock skew on a network drive.
+
+ file delete -force $name
+ close [open $name w]
+ set a [expr abs([clock seconds]-[file mtime $name])<10]
+ file delete $name
+ set a
+} {1}
+test cmdAH-24.7 {Tcl_FileObjCmd: mtime} {
+ list [catch {file mtime $file notint} msg] $msg
+} {1 {expected integer but got "notint"}}
+test cmdAH-24.8 {Tcl_FileObjCmd: mtime touch} {
+ set mtime [file mtime $file]
+ after 1100; # pause a sec to notice change in mtime
+ set newmtime [clock seconds]
+ expr {$newmtime==[file mtime $file $newmtime]}
+} 1
+
+
+# owned
+
+test cmdAH-25.1 {Tcl_FileObjCmd: owned} {
+ list [catch {file owned a b} msg] $msg
+} {1 {wrong # args: should be "file owned name"}}
+test cmdAH-25.2 {Tcl_FileObjCmd: owned} {
+ file owned gorp.file
+} 1
+test cmdAH-25.3 {Tcl_FileObjCmd: owned} {unixOnly notRoot} {
+ file owned /
+} 0
+
+# readlink
+
+test cmdAH-26.1 {Tcl_FileObjCmd: readlink} {
+ list [catch {file readlink a b} msg] $msg
+} {1 {wrong # args: should be "file readlink name"}}
+test cmdAH-26.2 {Tcl_FileObjCmd: readlink} {unixOnly nonPortable} {
+ file readlink link.file
+} gorp.file
+test cmdAH-26.3 {Tcl_FileObjCmd: readlink errors} {unixOnly nonPortable} {
+ list [catch {file readlink _bogus_} msg] [string tolower $msg] \
+ [string tolower $errorCode]
+} {1 {could not readlink "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
+test cmdAH-26.4 {Tcl_FileObjCmd: readlink errors} {macOnly nonPortable} {
+ list [catch {file readlink _bogus_} msg] [string tolower $msg] \
+ [string tolower $errorCode]
+} {1 {could not readlink "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
+test cmdAH-26.5 {Tcl_FileObjCmd: readlink errors} {pcOnly nonPortable} {
+ list [catch {file readlink _bogus_} msg] [string tolower $msg] \
+ [string tolower $errorCode]
+} {1 {could not readlink "_bogus_": invalid argument} {posix einval {invalid argument}}}
+
+# size
+
+test cmdAH-27.1 {Tcl_FileObjCmd: size} {
+ list [catch {file size a b} msg] $msg
+} {1 {wrong # args: should be "file size name"}}
+test cmdAH-27.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-27.3 {Tcl_FileObjCmd: size} {
+ string tolower [list [catch {file size _bogus_} msg] $msg \
+ $errorCode]
+} {1 {could not read "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
+
+# stat
+
+catch {testsetplatform $platform}
+makeFile "Test string" gorp.file
+catch {exec chmod 765 gorp.file}
+
+test cmdAH-28.1 {Tcl_FileObjCmd: stat} {
+ list [catch {file stat _bogus_} msg] $msg $errorCode
+} {1 {wrong # args: should be "file stat name varName"} NONE}
+test cmdAH-28.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-28.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-28.4 {Tcl_FileObjCmd: stat} {
+ catch {unset stat}
+ file stat gorp.file stat
+ list $stat(nlink) $stat(size) $stat(type)
+} {1 12 file}
+test cmdAH-28.5 {Tcl_FileObjCmd: stat} {unixOnly} {
+ catch {unset stat}
+ file stat gorp.file stat
+ expr $stat(mode)&0777
+} {501}
+test cmdAH-28.6 {Tcl_FileObjCmd: stat} {
+ string tolower [list [catch {file stat _bogus_ stat} msg] \
+ $msg $errorCode]
+} {1 {could not read "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
+test cmdAH-28.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}
+test cmdAH-28.8 {Tcl_FileObjCmd: stat} {
+ # Sign extension of purported unsigned short to int.
+
+ close [open foo.test w]
+ file stat foo.test stat
+ set x [expr {$stat(mode) > 0}]
+ file delete foo.test
+ set x
+} 1
+test cmdAH-28.9 {Tcl_FileObjCmd: stat} {pcOnly} {
+ # stat of root directory was failing.
+ # don't care about answer, just that test runs.
+
+ # relative paths that resolve to root
+ set old [pwd]
+ cd c:/
+ file stat c: stat
+ file stat c:. stat
+ file stat . stat
+ cd $old
+
+ file stat / stat
+ file stat c:/ stat
+ file stat c:/. stat
+} {}
+test cmdAH-28.10 {Tcl_FileObjCmd: stat} {pcOnly nonPortable} {
+ # stat of root directory was failing.
+ # don't care about answer, just that test runs.
+
+ file stat //pop/$env(USERNAME) stat
+ file stat //pop/$env(USERNAME)/ stat
+ file stat //pop/$env(USERNAME)/. stat
+} {}
+test cmdAH-28.11 {Tcl_FileObjCmd: stat} {pcOnly nonPortable} {
+ # stat of network directory was returning id of current local drive.
+
+ set old [pwd]
+ cd c:/
+
+ file stat //pop/$env(USERNAME) stat
+ cd $old
+ expr {$stat(dev) == 2}
+} 0
+test cmdAH-28.12 {Tcl_FileObjCmd: stat} {
+ # stat(mode) with S_IFREG flag was returned as a negative number
+ # if mode_t was a short instead of an unsigned short.
+
+ close [open foo.test w]
+ file stat foo.test stat
+ file delete foo.test
+ expr {$stat(mode) > 0}
+} 1
+catch {unset stat}
+
+# type
+
+file delete link.file
+
+test cmdAH-29.1 {Tcl_FileObjCmd: type} {
+ list [catch {file size a b} msg] $msg
+} {1 {wrong # args: should be "file size name"}}
+test cmdAH-29.2 {Tcl_FileObjCmd: type} {
+ file type dir.file
+} directory
+test cmdAH-29.3 {Tcl_FileObjCmd: type} {
+ file type gorp.file
+} file
+test cmdAH-29.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-29.5 {Tcl_FileObjCmd: type} {
+ string tolower [list [catch {file type _bogus_} msg] $msg $errorCode]
+} {1 {could not read "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
+
+# Error conditions
+
+test cmdAH-30.1 {Tcl_FileObjCmd: error conditions} {
+ list [catch {file gorp x} msg] $msg
+} {1 {bad option "gorp": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, type, volumes, or writable}}
+test cmdAH-30.2 {Tcl_FileObjCmd: error conditions} {
+ list [catch {file ex x} msg] $msg
+} {1 {ambiguous option "ex": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, type, volumes, or writable}}
+test cmdAH-30.3 {Tcl_FileObjCmd: error conditions} {
+ list [catch {file is x} msg] $msg
+} {1 {ambiguous option "is": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, type, volumes, or writable}}
+test cmdAH-30.4 {Tcl_FileObjCmd: error conditions} {
+ list [catch {file z x} msg] $msg
+} {1 {bad option "z": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, type, volumes, or writable}}
+test cmdAH-30.5 {Tcl_FileObjCmd: error conditions} {
+ list [catch {file read x} msg] $msg
+} {1 {ambiguous option "read": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, type, volumes, or writable}}
+test cmdAH-30.6 {Tcl_FileObjCmd: error conditions} {
+ list [catch {file s x} msg] $msg
+} {1 {ambiguous option "s": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, type, volumes, or writable}}
+test cmdAH-30.7 {Tcl_FileObjCmd: error conditions} {
+ list [catch {file t x} msg] $msg
+} {1 {ambiguous option "t": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, type, volumes, or writable}}
+test cmdAH-30.8 {Tcl_FileObjCmd: error conditions} {
+ list [catch {file dirname ~woohgy} msg] $msg
+} {1 {user "woohgy" doesn't exist}}
+
+# channels
+# In testing 'file channels', we need to make sure that a channel
+# created in one interp isn't visible in another.
+
+interp create simpleInterp
+interp create -safe safeInterp
+interp c
+safeInterp expose file file
+
+test cmdAH-31.1 {Tcl_FileObjCmd: channels, too many args} {
+ list [catch {file channels a b} msg] $msg
+} {1 {wrong # args: should be "file channels ?pattern?"}}
+test cmdAH-31.2 {Tcl_FileObjCmd: channels, too many args} {
+ # Normal interps start out with only the standard channels
+ lsort [simpleInterp eval [list file chan]]
+} [lsort {stderr stdout stdin}]
+test cmdAH-31.3 {Tcl_FileObjCmd: channels, globbing} {
+ string equal [file channels] [file channels *]
+} {1}
+test cmdAH-31.4 {Tcl_FileObjCmd: channels, globbing} {
+ lsort [file channels std*]
+} [lsort {stdout stderr stdin}]
+
+test cmdAH-31.5.0 {Tcl_FileObjCmd: channels} {fsIsWritable} {
+ catch {set newFileId [open gorp.file w]}
+} {0}
+
+test cmdAH-31.5 {Tcl_FileObjCmd: channels} {fsIsWritable} {
+ set res [file channels $newFileId]
+ string equal $newFileId $res
+} {1}
+test cmdAH-31.6 {Tcl_FileObjCmd: channels in other interp} {
+ # Safe interps start out with no channels
+ safeInterp eval [list file channels]
+} {}
+test cmdAH-31.7 {Tcl_FileObjCmd: channels in other interp} {fsIsWritable} {
+ list [catch {safeInterp eval [list puts $newFileId "hello"]} msg] $msg
+} [list 1 "can not find channel named \"$newFileId\""]
+
+catch {
+ interp share {} $newFileId safeInterp
+}
+interp share {} stdout safeInterp
+
+test cmdAH-31.8 {Tcl_FileObjCmd: channels in other interp} {fsIsWritable} {
+ # $newFileId should now be visible in both interps
+ list [file channels $newFileId] \
+ [safeInterp eval [list file channels $newFileId]]
+} [list $newFileId $newFileId]
+test cmdAH-31.9 {Tcl_FileObjCmd: channels in other interp} {fsIsWritable} {
+ lsort [safeInterp eval [list file channels]]
+} [lsort [list stdout $newFileId]]
+test cmdAH-31.10 {Tcl_FileObjCmd: channels in other interp} {fsIsWritable} {
+ # we can now write to $newFileId from slave
+ safeInterp eval [list puts $newFileId "hello"]
+} {}
+
+catch {
+ interp transfer {} $newFileId safeInterp
+}
+
+test cmdAH-31.11 {Tcl_FileObjCmd: channels in other interp} {fsIsWritable} {
+ # $newFileId should now be visible only in safeInterp
+ list [file channels $newFileId] \
+ [safeInterp eval [list file channels $newFileId]]
+} [list {} $newFileId]
+test cmdAH-31.12 {Tcl_FileObjCmd: channels in other interp} {fsIsWritable} {
+ lsort [safeInterp eval [list file channels]]
+} [lsort [list stdout $newFileId]]
+test cmdAH-31.13 {Tcl_FileObjCmd: channels in other interp} {fsIsWritable} {
+ safeInterp eval [list close $newFileId]
+ safeInterp eval [list file channels]
+} {stdout}
+
+# This shouldn't work, but just in case a test above failed...
+catch {close $newFileId}
+
+interp delete safeInterp
+interp delete simpleInterp
+
+# cleanup
+catch {testsetplatform $platform}
+catch {unset platform}
+
+# Tcl_ForObjCmd is tested in for.test
+
+catch {exec chmod 777 dir.file}
+catch {
+ file delete -force dir.file
+ file delete gorp.file
+ file delete link.file
+}
+
+cd $cmdAHwd
+
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+