summaryrefslogtreecommitdiffstats
path: root/tests/cmdAH.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/cmdAH.test')
-rw-r--r--tests/cmdAH.test305
1 files changed, 256 insertions, 49 deletions
diff --git a/tests/cmdAH.test b/tests/cmdAH.test
index f192b6a..afc012d 100644
--- a/tests/cmdAH.test
+++ b/tests/cmdAH.test
@@ -4,28 +4,33 @@
# 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.
+# Copyright © 1996-1998 Sun Microsystems, Inc.
+# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {"::tcltest" ni [namespace children]} {
- package require tcltest 2.1
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
::tcltest::loadTestedCommands
-catch [list package require -exact Tcltest [info patchlevel]]
+catch [list package require -exact tcl::test [info patchlevel]]
testConstraint testchmod [llength [info commands testchmod]]
testConstraint testsetplatform [llength [info commands testsetplatform]]
testConstraint testvolumetype [llength [info commands testvolumetype]]
+testConstraint time64bit [expr {
+ $::tcl_platform(pointerSize) >= 8 ||
+ [llength [info command testsize]] && [testsize st_mtime] >= 8
+}]
testConstraint linkDirectory [expr {
![testConstraint win] ||
- ([string index $tcl_platform(osVersion) 0] >= 5
+ ($::tcl_platform(osVersion) >= 5.0
&& [lindex [file system [temporaryDirectory]] 1] eq "NTFS")
}]
+testConstraint notWine [expr {![info exists ::env(CI_USING_WINE)]}]
global env
set cmdAHwd [pwd]
@@ -70,6 +75,12 @@ test cmdAH-1.2 {Tcl_CatchObjCmd, errors} {
test cmdAH-1.3 {Tcl_CatchObjCmd, errors} -returnCodes error -body {
catch foo bar baz spaz
} -result {wrong # args: should be "catch script ?resultVarName? ?optionVarName?"}
+test cmdAH-1.4 {Bug 3595576} {
+ catch {catch {} -> noSuchNs::var}
+} 1
+test cmdAH-1.5 {Bug 3595576} {
+ catch {catch error -> noSuchNs::var}
+} 1
test cmdAH-2.1 {Tcl_CdObjCmd} -returnCodes error -body {
cd foo bar
@@ -135,6 +146,13 @@ test cmdAH-2.6.2 {cd} -constraints {unix nonPortable} -setup {
} -cleanup {
cd $dir
} -result {/}
+test cmdAH-2.6.3 {Tcl_CdObjCmd, bug #3118489} -setup {
+ set dir [pwd]
+} -returnCodes error -body {
+ cd .\0
+} -cleanup {
+ cd $dir
+} -match glob -result "couldn't change working directory to \".\0\": *"
test cmdAH-2.7 {Tcl_ConcatObjCmd} {
concat
} {}
@@ -154,10 +172,10 @@ test cmdAH-3.2 {Tcl_ContinueObjCmd, success} {
test cmdAH-4.1 {Tcl_EncodingObjCmd} -returnCodes error -body {
encoding
-} -result {wrong # args: should be "encoding option ?arg ...?"}
+} -result {wrong # args: should be "encoding subcommand ?arg ...?"}
test cmdAH-4.2 {Tcl_EncodingObjCmd} -returnCodes error -body {
encoding foo
-} -result {bad option "foo": must be convertfrom, convertto, dirs, names, or system}
+} -result {unknown or ambiguous subcommand "foo": must be convertfrom, convertto, dirs, names, or system}
test cmdAH-4.3 {Tcl_EncodingObjCmd} -returnCodes error -body {
encoding convertto
} -result {wrong # args: should be "encoding convertto ?encoding? data"}
@@ -175,7 +193,7 @@ test cmdAH-4.5 {Tcl_EncodingObjCmd} -setup {
test cmdAH-4.6 {Tcl_EncodingObjCmd} -setup {
set system [encoding system]
} -body {
- encoding system identity
+ encoding system iso8859-1
encoding convertto jis0208 \u4e4e
} -cleanup {
encoding system $system
@@ -197,7 +215,7 @@ test cmdAH-4.9 {Tcl_EncodingObjCmd} -setup {
test cmdAH-4.10 {Tcl_EncodingObjCmd} -setup {
set system [encoding system]
} -body {
- encoding system identity
+ encoding system iso8859-1
encoding convertfrom jis0208 8C
} -cleanup {
encoding system $system
@@ -211,18 +229,18 @@ test cmdAH-4.12 {Tcl_EncodingObjCmd} -returnCodes error -body {
test cmdAH-4.13 {Tcl_EncodingObjCmd} -setup {
set system [encoding system]
} -body {
- encoding system identity
+ encoding system iso8859-1
encoding system
} -cleanup {
encoding system $system
-} -result identity
+} -result iso8859-1
test cmdAH-5.1 {Tcl_FileObjCmd} -returnCodes error -body {
file
} -result {wrong # args: should be "file subcommand ?arg ...?"}
test cmdAH-5.2 {Tcl_FileObjCmd} -returnCodes error -body {
file x
-} -result {unknown or ambiguous subcommand "x": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mkdir, mtime, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, tempfile, type, volumes, or writable}
+} -result {unknown or ambiguous subcommand "x": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mkdir, mtime, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, tempdir, tempfile, type, volumes, or writable}
test cmdAH-5.3 {Tcl_FileObjCmd} -returnCodes error -body {
file exists
} -result {wrong # args: should be "file exists name"}
@@ -244,7 +262,7 @@ test cmdAH-6.3 {Tcl_FileObjCmd: volumes} -constraints unix -body {
test cmdAH-6.4 {Tcl_FileObjCmd: volumes} -constraints win -body {
set volumeList [string tolower [file volumes]]
set element [lsearch -exact $volumeList "c:/"]
- list [expr {$element>-1}] [glob -nocomplain [lindex $volumeList $element]*]
+ list [expr {$element>=0}] [glob -nocomplain [lindex $volumeList $element]*]
} -match glob -result {1 *}
# attributes
@@ -306,7 +324,7 @@ test cmdAH-8.13 {Tcl_FileObjCmd: dirname} testsetplatform {
test cmdAH-8.14 {Tcl_FileObjCmd: dirname} testsetplatform {
testsetplatform unix
file dirname //foo
-} //
+} //foo
test cmdAH-8.15 {Tcl_FileObjCmd: dirname} testsetplatform {
testsetplatform unix
file dirname //foo/bar
@@ -450,7 +468,7 @@ test cmdAH-9.13 {Tcl_FileObjCmd: tail} testsetplatform {
test cmdAH-9.14 {Tcl_FileObjCmd: tail} testsetplatform {
testsetplatform unix
file tail //foo
-} foo
+} {}
test cmdAH-9.15 {Tcl_FileObjCmd: tail} testsetplatform {
testsetplatform unix
file tail //foo/bar
@@ -553,6 +571,13 @@ test cmdAH-9.51 {Tcl_FileObjCmd: tail} testsetplatform {
testsetplatform windows
file tail {foo\bar}
} bar
+test cmdAH-9.52 {Tcl_FileObjCmd: tail / normalize, bug 7a9dc52b29} {
+ list \
+ [file tail {~/~foo}] \
+ [file tail {~/test/~foo}] \
+ [file tail [file normalize {~/~foo}]] \
+ [file tail [file normalize {~/test/~foo}]]
+} [lrepeat 4 ./~foo]
# rootname
test cmdAH-10.1 {Tcl_FileObjCmd: rootname} -returnCodes error -body {
@@ -820,13 +845,13 @@ test cmdAH-16.1 {Tcl_FileObjCmd: readable} {
}
test cmdAH-16.2 {Tcl_FileObjCmd: readable} {
-constraints testchmod
- -setup {testchmod 0444 $gorpfile}
+ -setup {testchmod 0o444 $gorpfile}
-body {file readable $gorpfile}
-result 1
}
test cmdAH-16.3 {Tcl_FileObjCmd: readable} {
-constraints {unix notRoot testchmod}
- -setup {testchmod 0333 $gorpfile}
+ -setup {testchmod 0o333 $gorpfile}
-body {file readable $gorpfile}
-result 0
}
@@ -839,13 +864,13 @@ test cmdAH-17.1 {Tcl_FileObjCmd: writable} {
}
test cmdAH-17.2 {Tcl_FileObjCmd: writable} {
-constraints {notRoot testchmod}
- -setup {testchmod 0555 $gorpfile}
+ -setup {testchmod 0o555 $gorpfile}
-body {file writable $gorpfile}
-result 0
}
test cmdAH-17.3 {Tcl_FileObjCmd: writable} {
-constraints testchmod
- -setup {testchmod 0222 $gorpfile}
+ -setup {testchmod 0o222 $gorpfile}
-body {file writable $gorpfile}
-result 1
}
@@ -864,25 +889,25 @@ test cmdAH-18.2 {Tcl_FileObjCmd: executable} {notRoot} {
test cmdAH-18.3 {Tcl_FileObjCmd: executable} {unix testchmod} {
# Only on unix will setting the execute bit on a regular file cause that
# file to be executable.
- testchmod 0775 $gorpfile
+ testchmod 0o775 $gorpfile
file exe $gorpfile
} 1
test cmdAH-18.5 {Tcl_FileObjCmd: executable} -constraints {win} -body {
- # On pc, must be a .exe, .com, etc.
- set x [file exe $gorpfile]
- set gorpexe [makeFile foo gorp.exe]
- lappend x [file exe $gorpexe]
-} -cleanup {
- removeFile $gorpexe
-} -result {0 1}
-test cmdAH-18.5.1 {Tcl_FileObjCmd: executable} -constraints {win} -body {
- # On pc, must be a .exe, .com, etc.
- set x [file exe $gorpfile]
- set gorpexe [makeFile foo gorp.exe]
- lappend x [file exe [string toupper $gorpexe]]
+ # On windows, must be a .exe, .com, etc.
+ set x {}
+ set gorpexes {}
+ foreach ext {exe com cmd bat} {
+ lappend x [file exe nosuchfile.$ext]
+ set gorpexe [makeFile foo gorp.$ext]
+ lappend gorpexes $gorpexe
+ lappend x [file exe $gorpexe] [file exe [string toupper $gorpexe]]
+ }
+ set x
} -cleanup {
- removeFile $gorpexe
-} -result {0 1}
+ foreach gorpexe $gorpexes {
+ removeFile $gorpexe
+ }
+} -result {0 1 1 0 1 1 0 1 1 0 1 1}
test cmdAH-18.6 {Tcl_FileObjCmd: executable} {} {
# Directories are always executable.
file exe $dirfile
@@ -941,20 +966,33 @@ test cmdAH-19.11 {Tcl_FileObjCmd: exists} -constraints {unix notRoot} -setup {
} -body {
makeDirectory /tmp/tcl.foo.dir
makeFile 12345 /tmp/tcl.foo.dir/file
- file attributes /tmp/tcl.foo.dir -permissions 0000
+ file attributes /tmp/tcl.foo.dir -permissions 0
file exists /tmp/tcl.foo.dir/file
} -cleanup {
- file attributes /tmp/tcl.foo.dir -permissions 0775
+ file attributes /tmp/tcl.foo.dir -permissions 0o775
removeFile /tmp/tcl.foo.dir/file
removeDirectory /tmp/tcl.foo.dir
} -result 0
+test cmdAH-19.12 {Bug 3608360: [file exists] mustn't do globbing} -setup {
+ set newdirfile [makeDirectory newdir.file]
+ set cwd [pwd]
+ cd $newdirfile
+ # Content of file is totally unimportant; name is *not*
+ set innocentBystander [makeFile "abc" [file join $newdirfile foo.bar]]
+} -body {
+ list [file exists foo.bar] [file exists *.bar]
+} -cleanup {
+ cd $cwd
+ removeFile $innocentBystander
+ removeDirectory $newdirfile
+} -result {1 0}
# Stat related commands
catch {testsetplatform $platform}
removeFile $gorpfile
set gorpfile [makeFile "Test string" gorp.file]
-catch {file attributes $gorpfile -permissions 0765}
+catch {file attributes $gorpfile -permissions 0o765}
# avoid problems with non-local filesystems
if {[testConstraint unix] && [file exists /tmp]} {
@@ -1005,6 +1043,16 @@ test cmdAH-20.6 {Tcl_FileObjCmd: atime touch} -setup {
set modatime [file atime $file $newatime]
expr {$newatime == $modatime ? 1 : "$newatime != $modatime"}
} -result 1
+test cmdAH-20.7 {
+ Tcl_FileObjCmd: atime (built-in Windows names)
+} -constraints {win} -body {
+ file atime con
+} -result "could not get access time for file \"con\"" -returnCodes error
+test cmdAH-20.7.1 {
+ Tcl_FileObjCmd: atime (built-in Windows names with dir path and extension)
+} -constraints {win} -body {
+ file atime [file join [temporaryDirectory] CON.txt]
+} -match regexp -result {could not (?:get access time|read)} -returnCodes error
if {[testConstraint unix] && [file exists /tmp]} {
removeFile touch.me /tmp
@@ -1045,7 +1093,7 @@ test cmdAH-23.4 {Tcl_FileObjCmd: lstat} -setup {
unset -nocomplain stat
} -constraints {unix nonPortable} -body {
file lstat $linkfile stat
- list $stat(nlink) [expr $stat(mode)&0777] $stat(type)
+ list $stat(nlink) [expr {$stat(mode) & 0o777}] $stat(type)
} -result {1 511 link}
test cmdAH-23.5 {Tcl_FileObjCmd: lstat errors} {nonPortable} {
list [catch {file lstat _bogus_ stat} msg] [string tolower $msg] \
@@ -1236,13 +1284,59 @@ test cmdAH-24.13 {Tcl_FileObjCmd: directory mtime} -setup {
} -cleanup {
file delete -force $dirname
} -result {0 1}
+test cmdAH-24.14 {
+ Tcl_FileObjCmd: mtime (built-in Windows names)
+} -constraints {win} -body {
+ file mtime con
+} -result "could not get modification time for file \"con\"" -returnCodes error
+test cmdAH-24.14.1 {
+ Tcl_FileObjCmd: mtime (built-in Windows names with dir path and extension)
+} -constraints {win} -body {
+ file mtime [file join [temporaryDirectory] CON.txt]
+} -match regexp -result {could not (?:get modification time|read)} -returnCodes error
+
+# 3155760000 is 64-bit unix time, Wed Jan 01 00:00:00 GMT 2070:
+test cmdAH-24.20.1 {Tcl_FileObjCmd: atime 64-bit time_t, bug [4718b41c56]} -constraints {time64bit} -setup {
+ set filename [makeFile "" foo.text]
+} -body {
+ list [file atime $filename 3155760000] [file atime $filename]
+} -cleanup {
+ removeFile $filename
+} -result {3155760000 3155760000}
+test cmdAH-24.20.2 {Tcl_FileObjCmd: mtime 64-bit time_t, bug [4718b41c56]} -constraints {time64bit} -setup {
+ set filename [makeFile "" foo.text]
+} -body {
+ list [file mtime $filename 3155760000] [file mtime $filename]
+} -cleanup {
+ file delete -force $filename
+} -result {3155760000 3155760000}
# owned
test cmdAH-25.1 {Tcl_FileObjCmd: owned} -returnCodes error -body {
file owned a b
} -result {wrong # args: should be "file owned name"}
-test cmdAH-25.2 {Tcl_FileObjCmd: owned} -constraints win -body {
- file owned $gorpfile
+test cmdAH-25.2 {Tcl_FileObjCmd: owned} -constraints win -setup {
+ set fn $gorpfile
+ # prefer temp file to check owner (try to avoid bug [7de2d722bd]):
+ if {
+ [info exists ::env(TEMP)] && [file isdirectory $::env(TEMP)] &&
+ [file dirname $fn] ne [file normalize $::env(TEMP)]
+ } {
+ set fn [file join $::env(TEMP)/test-owner-from-tcl.txt]
+ set fn [makeFile "data" test-owner-from-tcl.txt $::env(TEMP)]
+ }
+ # be sure we have really owned this file before trying to check that
+ # (avoid dependency on admin with UAC and the setting "System objects:
+ # Default owner for objects created by members of the Administrators group"):
+ catch {
+ exec takeown /F [file nativename $fn]
+ }
+} -body {
+ file owned $fn
+} -cleanup {
+ if {$fn ne $gorpfile} {
+ removeFile $fn
+ }
} -result 1
test cmdAH-25.2.1 {Tcl_FileObjCmd: owned} -constraints unix -setup {
# Avoid problems with AFS
@@ -1255,6 +1349,16 @@ test cmdAH-25.2.1 {Tcl_FileObjCmd: owned} -constraints unix -setup {
test cmdAH-25.3 {Tcl_FileObjCmd: owned} {unix notRoot} {
file owned /
} 0
+test cmdAH-25.3.1 {Tcl_FileObjCmd: owned} -constraints {win notWine} -body {
+ if {[info exists env(SystemRoot)]} {
+ file owned $env(SystemRoot)
+ } else {
+ file owned $env(windir)
+ }
+} -result 0
+test cmdAH-25.4 {Tcl_FileObjCmd: owned} -body {
+ file owned nosuchfile
+} -result 0
# readlink
test cmdAH-26.1 {Tcl_FileObjCmd: readlink} -returnCodes error -body {
@@ -1285,11 +1389,26 @@ test cmdAH-27.2 {Tcl_FileObjCmd: size} {
test cmdAH-27.3 {Tcl_FileObjCmd: size} {
list [catch {file size _bogus_} msg] [string tolower $msg] $errorCode
} {1 {could not read "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}}
+test cmdAH-27.4 {
+ Tcl_FileObjCmd: size (built-in Windows names)
+} -constraints {win} -body {
+ file size con
+} -result 0
+test cmdAH-27.4.1 {
+ Tcl_FileObjCmd: size (built-in Windows names with dir path and extension)
+} -constraints {win} -body {
+ try {
+ set res [file size [file join [temporaryDirectory] con.txt]]
+ } trap {POSIX ENOENT} {} {
+ set res 0
+ }
+ set res
+} -result 0
catch {testsetplatform $platform}
removeFile $gorpfile
set gorpfile [makeFile "Test string" gorp.file]
-catch {file attributes $gorpfile -permissions 0765}
+catch {file attributes $gorpfile -permissions 0o765}
# stat
test cmdAH-28.1 {Tcl_FileObjCmd: stat} -returnCodes error -body {
@@ -1316,8 +1435,8 @@ test cmdAH-28.5 {Tcl_FileObjCmd: stat} -constraints {unix} -setup {
unset -nocomplain stat
} -body {
file stat $gorpfile stat
- expr {$stat(mode) & 0o777}
-} -result {501}
+ format 0o%03o [expr {$stat(mode) & 0o777}]
+} -result 0o765
test cmdAH-28.6 {Tcl_FileObjCmd: stat} {
list [catch {file stat _bogus_ stat} msg] [string tolower $msg] $errorCode
} {1 {could not read "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}}
@@ -1376,12 +1495,29 @@ test cmdAH-28.12 {Tcl_FileObjCmd: stat} -setup {
} -cleanup {
removeFile $filename
} -result 1
+test cmdAH-28.13 {Tcl_FileObjCmd: stat (built-in Windows names)} -constraints {win} -setup {
+ unset -nocomplain stat
+} -body {
+ file stat con stat
+ lmap elem {atime ctime dev gid ino mode mtime nlink size type uid} {set stat($elem)}
+} -result {0 0 -1 0 0 8630 0 0 0 characterSpecial 0}
+test cmdAH-28.13.1 {Tcl_FileObjCmd: stat (built-in Windows names)} -constraints {win} -setup {
+ unset -nocomplain stat
+} -body {
+ try {
+ file stat [file join [temporaryDirectory] CON.txt] stat
+ set res [lmap elem {atime ctime dev gid ino mode mtime nlink size type uid} {set stat($elem)}]
+ } trap {POSIX ENOENT} {} {
+ set res {0 0 -1 0 0 8630 0 0 0 characterSpecial 0}
+ }
+ set res
+} -result {0 0 -1 0 0 8630 0 0 0 characterSpecial 0}
unset -nocomplain stat
# type
test cmdAH-29.1 {Tcl_FileObjCmd: type} -returnCodes error -body {
- file size a b
-} -result {wrong # args: should be "file size name"}
+ file type a b
+} -result {wrong # args: should be "file type name"}
test cmdAH-29.2 {Tcl_FileObjCmd: type} {
file type $dirfile
} directory
@@ -1403,7 +1539,7 @@ test cmdAH-29.4 {Tcl_FileObjCmd: type} -constraints {unix} -setup {
} -cleanup {
file delete $linkfile
} -result link
-test cmdAH-29.4.1 {Tcl_FileObjCmd: type} -constraints {linkDirectory} -setup {
+test cmdAH-29.4.1 {Tcl_FileObjCmd: type} -constraints {linkDirectory notWine} -setup {
set tempdir [makeDirectory temp]
} -body {
set linkdir [file join [temporaryDirectory] link.dir]
@@ -1416,11 +1552,26 @@ test cmdAH-29.4.1 {Tcl_FileObjCmd: type} -constraints {linkDirectory} -setup {
test cmdAH-29.5 {Tcl_FileObjCmd: type} {
list [catch {file type _bogus_} msg] [string tolower $msg] $errorCode
} {1 {could not read "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}}
+test cmdAH-29.6 {
+ Tcl_FileObjCmd: type (built-in Windows names)
+} -constraints {win} -body {
+ file type con
+} -result "characterSpecial"
+test cmdAH-29.6.1 {
+ Tcl_FileObjCmd: type (built-in Windows names, with dir path and extension)
+} -constraints {win} -body {
+ try {
+ set res [file type [file join [temporaryDirectory] CON.txt]]
+ } trap {POSIX ENOENT} {} {
+ set res {characterSpecial}
+ }
+ set res
+} -result "characterSpecial"
# Error conditions
test cmdAH-30.1 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
file gorp x
-} -result {unknown or ambiguous subcommand "gorp": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mkdir, mtime, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, tempfile, type, volumes, or writable}
+} -result {unknown or ambiguous subcommand "gorp": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mkdir, mtime, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, tempdir, tempfile, type, volumes, or writable}
test cmdAH-30.2 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
file ex x
} -match glob -result {unknown or ambiguous subcommand "ex": must be *}
@@ -1488,7 +1639,7 @@ test cmdAH-31.9 {Tcl_FileObjCmd: channels in other interp} {
lsort [safeInterp eval [list file channels]]
} [lsort [list stdout $newFileId]]
test cmdAH-31.10 {Tcl_FileObjCmd: channels in other interp} {
- # we can now write to $newFileId from slave
+ # we can now write to $newFileId from child
safeInterp eval [list puts $newFileId "hello"]
} {}
interp transfer {} $newFileId safeInterp
@@ -1552,6 +1703,62 @@ test cmdAH-32.6 {file tempfile - templates} -body {
} -constraints {unix nonPortable} -cleanup {
catch {file delete $name}
} -result ok
+
+test cmdAH-33.1 {file tempdir} -body {
+ file tempdir a b
+} -returnCodes error -result {wrong # args: should be "file tempdir ?template?"}
+test cmdAH-33.2 {file tempdir} -body {
+ set d [file tempdir]
+ list [file tail $d] [file exists $d] [file type $d] \
+ [glob -nocomplain -directory $d *]
+} -match glob -result {tcl_* 1 directory {}} -cleanup {
+ catch {file delete $d}
+}
+test cmdAH-33.3 {file tempdir} -body {
+ set d [file tempdir gorp]
+ list [file tail $d] [file exists $d] [file type $d] \
+ [glob -nocomplain -directory $d *]
+} -match glob -result {gorp_* 1 directory {}} -cleanup {
+ catch {file delete $d}
+}
+test cmdAH-33.4 {file tempdir} -setup {
+ set base [file join [temporaryDirectory] gorp]
+ file mkdir $base
+} -body {
+ set pre [glob -nocomplain -directory $base *]
+ set d [file normalize [file tempdir $base/]]
+ list [string map [list $base GORP:] $d] [file exists $d] [file type $d] \
+ $pre [glob -nocomplain -directory $d *]
+} -match glob -result {GORP:/tcl_* 1 directory {} {}} -cleanup {
+ catch {file delete -force $base}
+}
+test cmdAH-33.5 {file tempdir} -setup {
+ set base [file join [temporaryDirectory] gorp]
+ file mkdir $base
+} -body {
+ set pre [glob -nocomplain -directory $base *]
+ set d [file normalize [file tempdir $base/gorp]]
+ list [string map [list $base GORP:] $d] [file exists $d] [file type $d] \
+ $pre [glob -nocomplain -directory $d *]
+} -match glob -result {GORP:/gorp_* 1 directory {} {}} -cleanup {
+ catch {file delete -force $base}
+}
+test cmdAH-33.6 {file tempdir: missing parent dir} -setup {
+ set base [file join [temporaryDirectory] gorp]
+ file mkdir $base
+} -returnCodes error -body {
+ file tempdir $base/quux/
+} -cleanup {
+ catch {file delete -force $base}
+} -result {can't create temporary directory: no such file or directory}
+test cmdAH-33.7 {file tempdir: missing parent dir} -setup {
+ set base [file join [temporaryDirectory] gorp]
+ file mkdir $base
+} -returnCodes error -body {
+ file tempdir $base/quux/foobar
+} -cleanup {
+ catch {file delete -force $base}
+} -result {can't create temporary directory: no such file or directory}
# This shouldn't work, but just in case a test above failed...
catch {close $newFileId}
@@ -1565,7 +1772,7 @@ unset -nocomplain platform
# Tcl_ForObjCmd is tested in for.test
-catch {file attributes $dirfile -permissions 0777}
+catch {file attributes $dirfile -permissions 0o777}
removeDirectory $dirfile
removeFile $gorpfile
# No idea how well [removeFile] copes with links...