summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2019-05-01 18:36:30 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2019-05-01 18:36:30 (GMT)
commitcedf26696f0576981f44118918709716b5f5c7f2 (patch)
tree211e05bba6da5a0f449a7a0713ef49d5f7a30192
parent6937b4c6707f892f964f153b2512891695a00b01 (diff)
downloadtcl-cedf26696f0576981f44118918709716b5f5c7f2.zip
tcl-cedf26696f0576981f44118918709716b5f5c7f2.tar.gz
tcl-cedf26696f0576981f44118918709716b5f5c7f2.tar.bz2
Tests
-rw-r--r--generic/tclBasic.c1
-rw-r--r--tests/cmdAH.test44
-rw-r--r--tests/interp.test2
3 files changed, 44 insertions, 3 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 84c87d0..4db275d 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -365,6 +365,7 @@ static const UnsafeEnsembleInfo unsafeEnsembleCommands[] = {
{"file", "size"},
{"file", "stat"},
{"file", "tail"},
+ {"file", "tempdir"},
{"file", "tempfile"},
{"file", "type"},
{"file", "volumes"},
diff --git a/tests/cmdAH.test b/tests/cmdAH.test
index 88c0367..3184747 100644
--- a/tests/cmdAH.test
+++ b/tests/cmdAH.test
@@ -235,7 +235,7 @@ test cmdAH-5.1 {Tcl_FileObjCmd} -returnCodes error -body {
} -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"}
@@ -1526,7 +1526,7 @@ test cmdAH-29.6.1 {
# 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 *}
@@ -1658,6 +1658,46 @@ 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 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 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}
+}
# This shouldn't work, but just in case a test above failed...
catch {close $newFileId}
diff --git a/tests/interp.test b/tests/interp.test
index 29e3b2d..76ac01f 100644
--- a/tests/interp.test
+++ b/tests/interp.test
@@ -20,7 +20,7 @@ catch [list package require -exact Tcltest [info patchlevel]]
testConstraint testinterpdelete [llength [info commands testinterpdelete]]
-set hidden_cmds {cd encoding exec exit fconfigure file glob load open pwd socket source tcl:encoding:dirs tcl:encoding:system tcl:file:atime tcl:file:attributes tcl:file:copy tcl:file:delete tcl:file:dirname tcl:file:executable tcl:file:exists tcl:file:extension tcl:file:isdirectory tcl:file:isfile tcl:file:link tcl:file:lstat tcl:file:mkdir tcl:file:mtime tcl:file:nativename tcl:file:normalize tcl:file:owned tcl:file:readable tcl:file:readlink tcl:file:rename tcl:file:rootname tcl:file:size tcl:file:stat tcl:file:tail tcl:file:tempfile tcl:file:type tcl:file:volumes tcl:file:writable tcl:info:cmdtype tcl:info:nameofexecutable tcl:process:autopurge tcl:process:list tcl:process:purge tcl:process:status tcl:zipfs:lmkimg tcl:zipfs:lmkzip tcl:zipfs:mkimg tcl:zipfs:mkkey tcl:zipfs:mkzip tcl:zipfs:mount tcl:zipfs:mount_data tcl:zipfs:unmount unload}
+set hidden_cmds {cd encoding exec exit fconfigure file glob load open pwd socket source tcl:encoding:dirs tcl:encoding:system tcl:file:atime tcl:file:attributes tcl:file:copy tcl:file:delete tcl:file:dirname tcl:file:executable tcl:file:exists tcl:file:extension tcl:file:isdirectory tcl:file:isfile tcl:file:link tcl:file:lstat tcl:file:mkdir tcl:file:mtime tcl:file:nativename tcl:file:normalize tcl:file:owned tcl:file:readable tcl:file:readlink tcl:file:rename tcl:file:rootname tcl:file:size tcl:file:stat tcl:file:tail tcl:file:tempdir tcl:file:tempfile tcl:file:type tcl:file:volumes tcl:file:writable tcl:info:cmdtype tcl:info:nameofexecutable tcl:process:autopurge tcl:process:list tcl:process:purge tcl:process:status tcl:zipfs:lmkimg tcl:zipfs:lmkzip tcl:zipfs:mkimg tcl:zipfs:mkkey tcl:zipfs:mkzip tcl:zipfs:mount tcl:zipfs:mount_data tcl:zipfs:unmount unload}
foreach i [interp slaves] {
interp delete $i