summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2002-07-10 13:08:19 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2002-07-10 13:08:19 (GMT)
commitfa2b7f9795b1febf4d941721b39d19d893e14af7 (patch)
treea913c7fa3f6353050f744311a07baa111e3c17b4
parentb82fab03b6af98493600f93ab86254446957ffdd (diff)
downloadtcl-fa2b7f9795b1febf4d941721b39d19d893e14af7.zip
tcl-fa2b7f9795b1febf4d941721b39d19d893e14af7.tar.gz
tcl-fa2b7f9795b1febf4d941721b39d19d893e14af7.tar.bz2
Removed [exec] of Unix utilities with equivs in standard Tcl [Bug 579268]
-rw-r--r--ChangeLog7
-rw-r--r--tests/fCmd.test126
-rw-r--r--tests/fileName.test10
-rw-r--r--tests/unixFCmd.test49
4 files changed, 93 insertions, 99 deletions
diff --git a/ChangeLog b/ChangeLog
index 9d3cbc2..e2a75d8 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2002-07-10 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+
+ * tests/unixFCmd.test, tests/fileName.test:
+ * tests/fCmd.test: Removed [exec] of Unix utilities that have
+ equivalents in standard Tcl. [Bug 579268] Also simplified some
+ of unixFCmd.test while I was at it.
+
2002-07-10 Don Porter <dgp@users.sourceforge.net>
* tests/basic.test: Cleaned up, constrained, and reduced the
diff --git a/tests/fCmd.test b/tests/fCmd.test
index 478feb7..6292fb2 100644
--- a/tests/fCmd.test
+++ b/tests/fCmd.test
@@ -10,7 +10,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: fCmd.test,v 1.19 2002/07/08 08:50:23 vincentdarley Exp $
+# RCS: @(#) $Id: fCmd.test,v 1.20 2002/07/10 13:08:20 dkf Exp $
#
if {[lsearch [namespace children] ::tcltest] == -1} {
@@ -544,18 +544,19 @@ test fCmd-6.23 {CopyRenameOneFile: TclpCopyDirectory failed} \
{unixOnly notRoot xdev} {
cleanup /tmp
file mkdir td1/td2/td3
- exec chmod 000 td1
+ file attributes td1 -permissions 0000
set msg [list [catch {file rename td1 /tmp} msg] $msg]
- exec chmod 755 td1
+ file attributes td1 -permissions 0755
set msg
} {1 {error renaming "td1": permission denied}}
test fCmd-6.24 {CopyRenameOneFile: error uses original name} \
{unixOnly notRoot} {
cleanup
file mkdir ~/td1/td2
- exec chmod 000 [file join [file dirname ~] [file tail ~] td1]
+ set td1name [file join [file dirname ~] [file tail ~] td1]
+ file attributes $td1name -permissions 0000
set msg [list [catch {file copy ~/td1 td1} msg] $msg]
- exec chmod 755 [file join [file dirname ~] [file tail ~] td1]
+ file attributes $td1name -permissions 0755
file delete -force ~/td1
set msg
} {1 {error copying "~/td1": permission denied}}
@@ -564,9 +565,10 @@ test fCmd-6.25 {CopyRenameOneFile: error uses original name} \
cleanup
file mkdir td2
file mkdir ~/td1
- exec chmod 000 [file join [file dirname ~] [file tail ~] td1]
+ set td1name [file join [file dirname ~] [file tail ~] td1]
+ file attributes $td1name -permissions 0000
set msg [list [catch {file copy td2 ~/td1} msg] $msg]
- exec chmod 755 [file join [file dirname ~] [file tail ~] td1]
+ file attributes $td1name -permissions 0755
file delete -force ~/td1
set msg
} {1 {error copying "td2" to "~/td1/td2": permission denied}}
@@ -574,9 +576,10 @@ test fCmd-6.26 {CopyRenameOneFile: doesn't use original name} \
{unixOnly notRoot} {
cleanup
file mkdir ~/td1/td2
- exec chmod 000 [file join [file dirname ~] [file tail ~] td1 td2]
+ set td2name [file join [file dirname ~] [file tail ~] td1 td2]
+ file attributes $td2name -permissions 0000
set msg [list [catch {file copy ~/td1 td1} msg] $msg]
- exec chmod 755 [file join [file dirname ~] [file tail ~] td1 td2]
+ file attributes $td2name -permissions 0755
file delete -force ~/td1
set msg
} "1 {error copying \"~/td1\" to \"td1\": \"[file join [file dirname ~] [file tail ~] td1 td2]\": permission denied}"
@@ -592,9 +595,9 @@ test fCmd-6.28 {CopyRenameOneFile: TclpCopyDirectory failed} \
{unixOnly notRoot xdev} {
cleanup /tmp
file mkdir td1/td2/td3
- exec chmod 000 td1/td2/td3
+ file attributes td1/td2/td3 -permissions 0000
set msg [list [catch {file rename td1 /tmp} msg] $msg]
- exec chmod 755 td1/td2/td3
+ file attributes td1/td2/td3 -permissions 0755
set msg
} {1 {error renaming "td1" to "/tmp/td1": "td1/td2/td3": permission denied}}
test fCmd-6.29 {CopyRenameOneFile: TclpCopyDirectory passed} \
@@ -1155,9 +1158,9 @@ test fCmd-12.8 {renamefile: generic error} {unixOnly notRoot} {
catch {file delete -force -- tfa}
file mkdir tfa
file mkdir tfa/dir
- exec chmod 555 tfa
+ file attributes tfa -permissions 0555
set result [catch {file rename tfa/dir tfa2}]
- exec chmod 777 tfa
+ file attributes tfa -permissions 0777
file delete -force tfa
set result
} {1}
@@ -1356,9 +1359,9 @@ test fCmd-14.7 {copyfile: copy directory succeeding} {notRoot} {
test fCmd-14.8 {copyfile: copy directory failing} {unixOnly notRoot} {
catch {file delete -force -- tfa}
file mkdir tfa/dir/a/b/c
- exec chmod 000 tfa/dir
+ file attributes tfa/dir -permissions 0000
set r1 [catch {file copy tfa tfa2}]
- exec chmod 777 tfa/dir
+ file attributes tfa/dir -permissions 0777
set result $r1
file delete -force tfa tfa2
set result
@@ -1399,9 +1402,9 @@ test fCmd-15.4 {TclMakeDirsCmd - stat failing} {unixOnly notRoot} {
catch {file delete -force -- tfa}
file mkdir tfa
createfile tfa/file
- exec chmod 000 tfa
+ file attributes tfa -permissions 0000
set result [catch {file mkdir tfa/file}]
- exec chmod 777 tfa
+ file attributes tfa -permissions 0777
file delete -force tfa
set result
} {1}
@@ -1445,21 +1448,21 @@ test fCmd-15.8 {TclFileMakeDirsCmd: trying to create an existing dir} {notRoot}
# Coverage tests for TclDeleteFilesCommand()
-test fCmd-16.1 { test the -- argument } {notRoot} {
+test fCmd-16.1 {test the -- argument} {notRoot} {
catch {file delete -force -- tfa}
createfile tfa
file delete -- tfa
file exists tfa
} {0}
-test fCmd-16.2 { test the -force and -- arguments } {notRoot} {
+test fCmd-16.2 {test the -force and -- arguments} {notRoot} {
catch {file delete -force -- tfa}
createfile tfa
file delete -force -- tfa
file exists tfa
} {0}
-test fCmd-16.3 { test bad option } {notRoot} {
+test fCmd-16.3 {test bad option} {notRoot} {
catch {file delete -force -- tfa}
createfile tfa
set result [catch {file delete -dog tfa}]
@@ -1467,11 +1470,11 @@ test fCmd-16.3 { test bad option } {notRoot} {
set result
} {1}
-test fCmd-16.4 { test not enough args } {notRoot} {
+test fCmd-16.4 {test not enough args} {notRoot} {
catch {file delete}
} {1}
-test fCmd-16.5 { test not enough args with options } {notRoot} {
+test fCmd-16.5 {test not enough args with options} {notRoot} {
catch {file delete --}
} {1}
@@ -1506,14 +1509,14 @@ test fCmd-16.9 {error while deleting file } {unixOnly notRoot} {
catch {file delete -force -- tfa}
file mkdir tfa
createfile tfa/a
- exec chmod 555 tfa
+ file attributes tfa -permissions 0555
set result [catch {file delete tfa/a }]
#######
####### If any directory in a tree that is being removed does not
####### have write permission, the process will fail!
####### This is also the case with "rm -rf"
#######
- exec chmod 777 tfa
+ file attributes tfa -permissions 0777
file delete -force tfa
set result
} {1}
@@ -1526,7 +1529,7 @@ test fCmd-16.10 {deleting multiple files} {notRoot} {
expr ![file exists tfa1] && ![file exists tfa2]
} {1}
-test fCmd-16.11 { TclFileDeleteCmd: removing a nonexistant file} {notRoot} {
+test fCmd-16.11 {TclFileDeleteCmd: removing a nonexistant file} {notRoot} {
catch {file delete -force -- tfa}
file delete tfa
set result 1
@@ -1536,9 +1539,9 @@ test fCmd-16.11 { TclFileDeleteCmd: removing a nonexistant file} {notRoot} {
test fCmd-17.1 {mkdir stat failing on target but not ENOENT} {unixOnly notRoot} {
catch {file delete -force -- tfa1}
file mkdir tfa1
- exec chmod 555 tfa1
+ file attributes tfa1 -permissions 0555
set result [catch {file mkdir tfa1/tfa2}]
- exec chmod 777 tfa1
+ file attributes tfa1 -permissions 0777
file delete -force tfa1
set result
} {1}
@@ -1694,10 +1697,10 @@ test fCmd-18.12 {TclFileRenameCmd : rename a symbolic link to file} \
catch {file delete -force -- tfa1 tfa2 tfa3}
set s [createfile tfa1]
- exec ln -s tfa1 tfa2
+ file link -symbolic tfa2 tfa1
file rename tfa2 tfa3
set t [file type tfa3]
- set result [expr { $t == "link" }]
+ set result [expr {$t eq "link"}]
file delete tfa1 tfa3
set result
} {1}
@@ -1707,10 +1710,10 @@ test fCmd-18.13 {TclFileRenameCmd : rename a symbolic link to dir} \
catch {file delete -force -- tfa1 tfa2 tfa3}
file mkdir tfa1
- exec ln -s tfa1 tfa2
+ file link -symbolic tfa2 tfa1
file rename tfa2 tfa3
set t [file type tfa3]
- set result [expr { $t == "link" }]
+ set result [expr {$t eq "link"}]
file delete tfa1 tfa3
set result
} {1}
@@ -1723,7 +1726,7 @@ test fCmd-18.14 {TclFileRenameCmd : rename a path with sym link} \
file mkdir tfa2
set f [file join [pwd] tfa1/a/b]
set f2 [file join [pwd] {tfa2/b alias}]
- exec ln -s $f $f2
+ file link -symbolic $f2 $f
file rename {tfa2/b alias/c} tfa3
set r1 [file isdir tfa3]
set r2 [file exists tfa1/a/b/c]
@@ -1738,7 +1741,7 @@ test fCmd-18.15 {TclFileRenameCmd : rename a file to a symlink dir} \
file mkdir tfa1
set s [createfile tfa2]
- exec ln -s tfa1 tfalink
+ file link -symbolic tfalink tfa1
file rename tfa2 tfalink
set result [checkcontent tfa1/tfa2 $s ]
@@ -1750,7 +1753,7 @@ test fCmd-18.16 {TclFileRenameCmd: rename a dangling symlink} {unixOnly notRoot}
catch {file delete -force -- tfa1 tfalink}
file mkdir tfa1
- exec ln -s tfa1 tfalink
+ file link -symbolic tfalink tfa1
file delete tfa1
file rename tfalink tfa2
set result [expr [string compare [file type tfa2] "link"] == 0]
@@ -1762,25 +1765,25 @@ test fCmd-18.16 {TclFileRenameCmd: rename a dangling symlink} {unixOnly notRoot}
#
# Coverage tests for TclUnixRmdir
#
-test fCmd-19.1 { remove empty directory } {notRoot} {
+test fCmd-19.1 {remove empty directory} {notRoot} {
catch {file delete -force -- tfa}
file mkdir tfa
file delete tfa
file exists tfa
} {0}
-test fCmd-19.2 { rmdir error besides EEXIST} {unixOnly notRoot} {
+test fCmd-19.2 {rmdir error besides EEXIST} {unixOnly notRoot} {
catch {file delete -force -- tfa}
file mkdir tfa
file mkdir tfa/a
- exec chmod 555 tfa
+ file attributes tfa -permissions 0555
set result [catch {file delete tfa/a}]
- exec chmod 777 tfa
+ file attributes tfa -permissions 0777
file delete -force tfa
set result
} {1}
-test fCmd-19.3 { recursive remove } {notRoot} {
+test fCmd-19.3 {recursive remove} {notRoot} {
catch {file delete -force -- tfa}
file mkdir tfa
file mkdir tfa/a
@@ -1803,9 +1806,9 @@ test fCmd-20.1 {TraverseUnixTree : failure opening a subdirectory directory } \
catch {file delete -force -- tfa}
file mkdir tfa
file mkdir tfa/a
- exec chmod 000 tfa/a
+ file attributes tfa/a -permissions 0000
set result [catch {file delete -force tfa}]
- exec chmod 777 tfa/a
+ file attributes tfa/a -permissions 0777
file delete -force tfa
set result
} {1}
@@ -1884,7 +1887,7 @@ test fCmd-21.6 {copy: mixed dirs and files into directory} \
test fCmd-21.7 {TclCopyFilesCmd: copy a dangling link} {unixOnly notRoot} {
file mkdir tfad1
- exec ln -s tfad1 tfalink
+ file link -symbolic tfalink tfad1
file delete tfad1
file copy tfalink tfalink2
set result [string match [file type tfalink2] link]
@@ -1894,7 +1897,7 @@ test fCmd-21.7 {TclCopyFilesCmd: copy a dangling link} {unixOnly notRoot} {
test fCmd-21.8 {TclCopyFilesCmd : copy a link } {unixOnly notRoot} {
file mkdir tfad1
- exec ln -s tfad1 tfalink
+ file link -symbolic tfalink tfad1
file copy tfalink tfalink2
set r1 [file type tfalink]
set r2 [file type tfalink2]
@@ -1906,7 +1909,7 @@ test fCmd-21.8 {TclCopyFilesCmd : copy a link } {unixOnly notRoot} {
test fCmd-21.9 {TclCopyFilesCmd: copy dir with a link in it} {unixOnly notRoot} {
file mkdir tfad1
- exec ln -s "[pwd]/tfad1" tfad1/tfalink
+ file link -symbolic tfad1/tfalink "[pwd]/tfad1"
file copy tfad1 tfad2
set result [string match [file type tfad2/tfalink] link]
file delete -force tfad1 tfad2
@@ -1966,7 +1969,7 @@ test fCmd-22.2 {TclpRenameFile: attempt to overwrite itself} {macOrUnix notRoot}
set result
} {1}
-test fCmd-22.3 { TclpRenameFile : rename dir to existing dir } {notRoot} {
+test fCmd-22.3 {TclpRenameFile: rename dir to existing dir} {notRoot} {
catch {file delete -force -- d1 tfad}
file mkdir d1 [file join tfad d1]
set r1 [catch {file rename d1 tfad}]
@@ -2036,8 +2039,7 @@ test fCmd-24.1 {TclMacDeleteFile: deleting a normal file} {notRoot} {
# TclMacCopyDirectory
# Error cases are not covered.
#
-test fCmd-25.1 { TclMacCopyDirectory : copying a normal directory} \
- {notRoot notFileSharing} {
+test fCmd-25.1 {TclMacCopyDirectory: copying a normal directory} {notRoot notFileSharing} {
catch {file delete -force -- tfad1 tfad2}
file mkdir [file join tfad1 a b c]
@@ -2047,8 +2049,7 @@ test fCmd-25.1 { TclMacCopyDirectory : copying a normal directory} \
set result
} {1}
-test fCmd-25.2 { TclMacCopyDirectory : copying a short path normal directory} \
- {notRoot notFileSharing} {
+test fCmd-25.2 {TclMacCopyDirectory: copying a short path normal directory} {notRoot notFileSharing} {
catch {file delete -force -- tfad1 tfad2}
file mkdir tfad1
@@ -2058,8 +2059,7 @@ test fCmd-25.2 { TclMacCopyDirectory : copying a short path normal directory} \
set result
} {1}
-test fCmd-25.3 { TclMacCopyDirectory : copying dirs between different dirs} \
- {notRoot notFileSharing} {
+test fCmd-25.3 {TclMacCopyDirectory: copying dirs between different dirs} {notRoot notFileSharing} {
catch {file delete -force -- tfad1 tfad2}
file mkdir [file join tfad1 x y z]
@@ -2074,11 +2074,11 @@ test fCmd-25.3 { TclMacCopyDirectory : copying dirs between different dirs} \
# Functionality tests for TclDeleteFilesCmd
#
-test fCmd-26.1 { TclDeleteFilesCmd : delete symlink} {unixOnly notRoot} {
+test fCmd-26.1 {TclDeleteFilesCmd: delete symlink} {unixOnly notRoot} {
catch {file delete -force -- tfad1 tfad2}
file mkdir tfad1
- exec ln -s tfad1 tfalink
+ file link -symbolic tfalink tfad1
file delete tfalink
set r1 [file isdir tfad1]
@@ -2089,12 +2089,12 @@ test fCmd-26.1 { TclDeleteFilesCmd : delete symlink} {unixOnly notRoot} {
set result
} {1}
-test fCmd-26.2 { TclDeleteFilesCmd : delete dir with symlink} {unixOnly notRoot} {
+test fCmd-26.2 {TclDeleteFilesCmd: delete dir with symlink} {unixOnly notRoot} {
catch {file delete -force -- tfad1 tfad2}
file mkdir tfad1
file mkdir tfad2
- exec ln -s tfad1 [file join tfad2 link]
+ file link -symbolic [file join tfad2 link] tfad1
file delete -force tfad2
set r1 [file isdir tfad1]
@@ -2105,11 +2105,11 @@ test fCmd-26.2 { TclDeleteFilesCmd : delete dir with symlink} {unixOnly notRoot}
set result
} {1}
-test fCmd-26.3 { TclDeleteFilesCmd : delete dangling symlink} {unixOnly notRoot} {
+test fCmd-26.3 {TclDeleteFilesCmd: delete dangling symlink} {unixOnly notRoot} {
catch {file delete -force -- tfad1 tfad2}
file mkdir tfad1
- exec ln -s tfad1 tfad2
+ file link -symbolic tfad2 tfad1
file delete tfad1
file delete tfad2
@@ -2349,15 +2349,3 @@ removeDirectory abc.dir
cleanup
::tcltest::cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/fileName.test b/tests/fileName.test
index 13620a6..d9dd9d4 100644
--- a/tests/fileName.test
+++ b/tests/fileName.test
@@ -10,7 +10,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: fileName.test,v 1.25 2002/07/08 08:50:23 vincentdarley Exp $
+# RCS: @(#) $Id: fileName.test,v 1.26 2002/07/10 13:08:20 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -1701,7 +1701,7 @@ unset globname
# On some systems, like AFS, "000" protection doesn't prevent
# access by owner, so the following test is not portable.
-catch {exec chmod 000 globTest/a1}
+catch {file attributes globTest/a1 -permissions 0000}
test filename-15.1 {unix specific globbing} {unixOnly nonPortable} {
string tolower [list [catch {glob globTest/a1/*} msg] $msg $errorCode]
} {1 {couldn't read directory "globtest/a1": permission denied} {posix eacces {permission denied}}}
@@ -1715,7 +1715,7 @@ test filename-15.3 {unix specific no complain: no errors, good result} \
glob -nocomplain globTest/a2 globTest/a1/* globTest/a3
} {globTest/a2 globTest/a3}
-catch {exec chmod 755 globTest/a1}
+catch {file attributes globTest/a1 -permissions 0755}
test filename-15.4 {unix specific no complain: no errors, good result} \
{unixOnly nonPortable} {
# test fails because if an error occurs, the interp's result
@@ -1741,7 +1741,7 @@ test filename-15.6 {unix specific globbing} {unixOnly} {
set env(HOME) $temp
set result
} [list 0 [list [lindex [glob ~] 0]/globTest/odd\\\[\]*?\{\}name]]
-catch {exec rm -f globTest/odd\\\[\]*?\{\}name}
+catch {file delete -force globTest/odd\\\[\]*?\{\}name}
# The following tests are only valid for Windows systems.
set oldDir [pwd]
@@ -1818,8 +1818,8 @@ test filename-16.16 {windows specific globbing} {pcOnly} {
# cleanup
catch {file delete -force C:/globTest}
-cd $oldpwd
file delete -force globTest
+cd $oldpwd
set env(HOME) $oldhome
if {[tcltest::testConstraint testsetplatform]} {
testsetplatform $platform
diff --git a/tests/unixFCmd.test b/tests/unixFCmd.test
index 8cccb51..23e8752 100644
--- a/tests/unixFCmd.test
+++ b/tests/unixFCmd.test
@@ -9,7 +9,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: unixFCmd.test,v 1.13 2002/07/05 10:38:43 dkf Exp $
+# RCS: @(#) $Id: unixFCmd.test,v 1.14 2002/07/10 13:08:20 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -62,9 +62,9 @@ proc cleanup {args} {
test unixFCmd-1.1 {TclpRenameFile: EACCES} {unixOnly notRoot} {
cleanup
file mkdir td1/td2/td3
- exec chmod 000 td1/td2
+ file attributes td1/td2 -permissions 0000
set msg [list [catch {file rename td1/td2/td3 td2} msg] $msg]
- exec chmod 755 td1/td2
+ file attributes td1/td2 -permissions 0755
set msg
} {1 {error renaming "td1/td2/td3": permission denied}}
test unixFCmd-1.2 {TclpRenameFile: EEXIST} {unixOnly notRoot} {
@@ -123,13 +123,14 @@ test unixFCmd-1.9 {Checking EINTR Bug} {unixOnly notRoot nonPortable} {
test unixFCmd-2.1 {TclpCopyFile: target exists: lstat(dst) == 0} \
{unixOnly notRoot} {
cleanup
- exec touch tf1
- exec touch tf2
+ close [open tf1 a]
+ close [open tf2 a]
file copy -force tf1 tf2
} {}
test unixFCmd-2.2 {TclpCopyFile: src is symlink} {unixOnly notRoot} {
cleanup
- exec ln -s tf1 tf2
+ close [open tf1 a]
+ file link -symbolic tf2 tf1
file copy tf2 tf3
file type tf3
} {link}
@@ -152,11 +153,11 @@ test unixFCmd-2.4 {TclpCopyFile: src is fifo} {unixOnly notRoot} {
} {1}
test unixFCmd-2.5 {TclpCopyFile: copy attributes} {unixOnly notRoot} {
cleanup
- exec touch tf1
- exec chmod 472 tf1
+ close [open tf1 a]
+ file attributes tf1 -permissions 0472
file copy tf1 tf2
- string range [exec ls -l tf2] 0 9
-} {-r--rwx-w-}
+ file attributes tf2 -permissions
+} 00472 ;# i.e. perms field of [exec ls -l tf2] is -r--rwx-w-
test unixFCmd-3.1 {CopyFile not done} {emptyTest unixOnly notRoot} {
} {}
@@ -282,22 +283,20 @@ test unixFCmd-17.3 {SetPermissionsAttribute} {unixOnly notRoot} {
close [open foo.test w]
set ::i 4
-proc permcheck {permstr expected} {
- test unixFCmd-17.[incr ::i] {SetPermissionsAttribute} {unixOnly notRoot} \
- [subst {
+proc permcheck {testnum permstr expected} {
+ test $testnum {SetPermissionsAttribute} {unixOnly notRoot} {
file attributes foo.test -permissions $permstr
file attributes foo.test -permissions
- }
- ] $expected
+ } $expected
}
-permcheck rwxrwxrwx 00777
-permcheck r--r---w- 00442
-permcheck 0 00000
-permcheck u+rwx,g+r 00740
-permcheck u-w 00540
-permcheck o+rwx 00547
-permcheck --x--x--x 00111
-permcheck a+rwx 00777
+permcheck unixFCmd-17.4 rwxrwxrwx 00777
+permcheck unixFCmd-17.5 r--r---w- 00442
+permcheck unixFCmd-17.6 0 00000
+permcheck unixFCmd-17.7 u+rwx,g+r 00740
+permcheck unixFCmd-17.8 u-w 00540
+permcheck unixFCmd-17.9 o+rwx 00547
+permcheck unixFCmd-17.10 --x--x--x 00111
+permcheck unixFCmd-17.11 a+rwx 00777
file delete -force -- foo.test
test unixFCmd-18.1 {Unix pwd} {nonPortable unixOnly notRoot} {
@@ -307,10 +306,10 @@ test unixFCmd-18.1 {Unix pwd} {nonPortable unixOnly notRoot} {
set nd $cd/tstdir
file mkdir $nd
cd $nd
- exec chmod 000 $nd
+ file attributes $nd -permissions 0000
set r [list [catch {pwd} res] [string range $res 0 36]];
cd $cd;
- exec chmod 755 $nd
+ file attributes $nd -permissions 0755
file delete $nd
set r
} {1 {error getting working directory name:}}