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