summaryrefslogtreecommitdiffstats
path: root/tests/unixFCmd.test
diff options
context:
space:
mode:
authorstanton <stanton@noemail.net>1999-04-16 00:46:29 (GMT)
committerstanton <stanton@noemail.net>1999-04-16 00:46:29 (GMT)
commit98569293dc21e22480004e4e3f2ce85ec0bfd80f (patch)
treece9959f2747257d98d52ec8d18bf3b0de99b9535 /tests/unixFCmd.test
parent6a4a1d8213f4de5bce0eaafa8f4d86117022bf1a (diff)
downloadtcl-98569293dc21e22480004e4e3f2ce85ec0bfd80f.zip
tcl-98569293dc21e22480004e4e3f2ce85ec0bfd80f.tar.gz
tcl-98569293dc21e22480004e4e3f2ce85ec0bfd80f.tar.bz2
merged tcl 8.1 branch back into the main trunk
FossilOrigin-Name: f3b32fb71c9011ac220779bd9dbe5617c9dc87d9
Diffstat (limited to 'tests/unixFCmd.test')
-rw-r--r--tests/unixFCmd.test168
1 files changed, 99 insertions, 69 deletions
diff --git a/tests/unixFCmd.test b/tests/unixFCmd.test
index 76febd0..d026aa3 100644
--- a/tests/unixFCmd.test
+++ b/tests/unixFCmd.test
@@ -9,18 +9,22 @@
# 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.5 1998/09/14 18:40:14 stanton Exp $
+# RCS: @(#) $Id: unixFCmd.test,v 1.6 1999/04/16 00:47:35 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
-
-if {$tcl_platform(platform) != "unix"} {
- return
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
}
-if {$user == "root"} {
- puts "Skipping unixFCmd tests. They depend on not being able to write to"
- puts "certain directories. It would be too dangerous to run them as root."
- return
+# Several tests require need to match results against the unix username
+set user {}
+if {$tcl_platform(platform) == "unix"} {
+ catch {set user [exec whoami]}
+ if {$user == ""} {
+ catch {regexp {^[^(]*\(([^)]*)\)} [exec id] dummy user}
+ }
+ if {$user == ""} {
+ set user "root"
+ }
}
proc openup {path} {
@@ -49,7 +53,7 @@ proc cleanup {args} {
}
}
-test unixFCmd-1.1 {TclpRenameFile: EACCES} {
+test unixFCmd-1.1 {TclpRenameFile: EACCES} {unixOnly notRoot} {
cleanup
file mkdir td1/td2/td3
exec chmod 000 td1/td2
@@ -57,46 +61,45 @@ test unixFCmd-1.1 {TclpRenameFile: EACCES} {
exec chmod 755 td1/td2
set msg
} {1 {error renaming "td1/td2/td3": permission denied}}
-test unixFCmd-1.2 {TclpRenameFile: EEXIST} {
+test unixFCmd-1.2 {TclpRenameFile: EEXIST} {unixOnly notRoot} {
cleanup
file mkdir td1/td2
file mkdir td2
list [catch {file rename td2 td1} msg] $msg
} {1 {error renaming "td2" to "td1/td2": file already exists}}
-test unixFCmd-1.3 {TclpRenameFile: EINVAL} {
+test unixFCmd-1.3 {TclpRenameFile: EINVAL} {unixOnly notRoot} {
cleanup
file mkdir td1
list [catch {file rename td1 td1} msg] $msg
} {1 {error renaming "td1" to "td1/td1": trying to rename a volume or move a directory into itself}}
-test unixFCmd-1.4 {TclpRenameFile: EISDIR} {
+test unixFCmd-1.4 {TclpRenameFile: EISDIR} {emptyTest unixOnly notRoot} {
# can't make it happen
} {}
-test unixFCmd-1.5 {TclpRenameFile: ENOENT} {
+test unixFCmd-1.5 {TclpRenameFile: ENOENT} {unixOnly notRoot} {
cleanup
file mkdir td1
list [catch {file rename td2 td1} msg] $msg
} {1 {error renaming "td2": no such file or directory}}
-test unixFCmd-1.6 {TclpRenameFile: ENOTDIR} {
+test unixFCmd-1.6 {TclpRenameFile: ENOTDIR} {emptyTest unixOnly notRoot} {
# can't make it happen
} {}
-test unixFCmd-1.7 {TclpRenameFile: EXDEV} {
+test unixFCmd-1.7 {TclpRenameFile: EXDEV} {unixOnly notRoot} {
cleanup
file mkdir foo/bar
file attr foo -perm 040555
- set msg [list [catch {file rename foo/bar /tmp} msg] $msg]
- set a1 {1 {can't unlink "foo/bar": permission denied}}
- set result [expr {$msg == $a1}]
+ set catchResult [catch {file rename foo/bar /tmp} msg]
+ set msg [lindex [split $msg :] end]
catch {file delete /tmp/bar}
catch {file attr foo -perm 040777}
catch {file delete -force foo}
- set result
-} {1}
-test unixFCmd-1.8 {Checking EINTR Bug} nonPortable {
+ list $catchResult $msg
+} {1 { permission denied}}
+test unixFCmd-1.8 {Checking EINTR Bug} {unixOnly notRoot nonPortable} {
testalarm
after 2000
list [testgotsig] [testgotsig]
} {1 0}
-test unixFCmd-1.9 {Checking EINTR Bug} nonPortable {
+test unixFCmd-1.9 {Checking EINTR Bug} {unixOnly notRoot nonPortable} {
cleanup
set f [open tfalarm w]
puts $f {
@@ -111,19 +114,20 @@ test unixFCmd-1.9 {Checking EINTR Bug} nonPortable {
catch {close $pipe}
list $line [testgotsig]
} {h 1}
-test unixFCmd-2.1 {TclpCopyFile: target exists: lstat(dst) == 0} {
+test unixFCmd-2.1 {TclpCopyFile: target exists: lstat(dst) == 0} \
+ {unixOnly notRoot} {
cleanup
exec touch tf1
exec touch tf2
file copy -force tf1 tf2
} {}
-test unixFCmd-2.2 {TclpCopyFile: src is symlink} {
+test unixFCmd-2.2 {TclpCopyFile: src is symlink} {unixOnly notRoot} {
cleanup
exec ln -s tf1 tf2
file copy tf2 tf3
file type tf3
} {link}
-test unixFCmd-2.3 {TclpCopyFile: src is block} {
+test unixFCmd-2.3 {TclpCopyFile: src is block} {unixOnly notRoot} {
cleanup
set null "/dev/null"
while {[file type $null] != "characterSpecial"} {
@@ -131,7 +135,7 @@ test unixFCmd-2.3 {TclpCopyFile: src is block} {
}
# file copy $null tf1
} {}
-test unixFCmd-2.4 {TclpCopyFile: src is fifo} {
+test unixFCmd-2.4 {TclpCopyFile: src is fifo} {unixOnly notRoot} {
cleanup
if [catch {exec mknod tf1 p}] {
list 1
@@ -140,7 +144,7 @@ test unixFCmd-2.4 {TclpCopyFile: src is fifo} {
expr {"[file type tf1]" == "[file type tf2]"}
}
} {1}
-test unixFCmd-2.5 {TclpCopyFile: copy attributes} {
+test unixFCmd-2.5 {TclpCopyFile: copy attributes} {unixOnly notRoot} {
cleanup
exec touch tf1
exec chmod 472 tf1
@@ -148,111 +152,122 @@ test unixFCmd-2.5 {TclpCopyFile: copy attributes} {
string range [exec ls -l tf2] 0 9
} {-r--rwx-w-}
-test unixFCmd-3.1 {CopyFile not done} {
+test unixFCmd-3.1 {CopyFile not done} {emptyTest unixOnly notRoot} {
} {}
-test unixFCmd-4.1 {TclpDeleteFile not done} {
+test unixFCmd-4.1 {TclpDeleteFile not done} {emptyTest unixOnly notRoot} {
} {}
-test unixFCmd-5.1 {TclpCreateDirectory not done} {
+test unixFCmd-5.1 {TclpCreateDirectory not done} {emptyTest unixOnly notRoot} {
} {}
-test unixFCmd-6.1 {TclpCopyDirectory not done} {
+test unixFCmd-6.1 {TclpCopyDirectory not done} {emptyTest unixOnly notRoot} {
} {}
-test unixFCmd-7.1 {TclpRemoveDirectory not done} {
+test unixFCmd-7.1 {TclpRemoveDirectory not done} {emptyTest unixOnly notRoot} {
} {}
-test unixFCmd-8.1 {TraverseUnixTree not done} {
+test unixFCmd-8.1 {TraverseUnixTree not done} {emptyTest unixOnly notRoot} {
} {}
-test unixFCmd-9.1 {TraversalCopy not done} {
+test unixFCmd-9.1 {TraversalCopy not done} {emptyTest unixOnly notRoot} {
} {}
-test unixFCmd-10.1 {TraversalDelete not done} {
+test unixFCmd-10.1 {TraversalDelete not done} {emptyTest unixOnly notRoot} {
} {}
-test unixFCmd-11.1 {CopyFileAttrs not done} {
+test unixFCmd-11.1 {CopyFileAttrs not done} {emptyTest unixOnly notRoot} {
} {}
-set testConfig(tclGroup) 0
-if {[catch {exec {groups}} groupList] == 0} {
- if {[lsearch $groupList tcl] != -1} {
- set testConfig(tclGroup) 1
- }
-}
-
-test unixFCmd-12.1 {GetGroupAttribute - file not found} {
+test unixFCmd-12.1 {GetGroupAttribute - file not found} {unixOnly notRoot} {
catch {file delete -force -- foo.test}
list [catch {file attributes foo.test -group} msg] $msg
-} {1 {could not stat file "foo.test": no such file or directory}}
-test unixFCmd-12.2 {GetGroupAttribute - file found} {
+} {1 {could not read "foo.test": no such file or directory}}
+test unixFCmd-12.2 {GetGroupAttribute - file found} {unixOnly notRoot} {
catch {file delete -force -- foo.test}
close [open foo.test w]
list [catch {file attributes foo.test -group}] [file delete -force -- foo.test]
} {0 {}}
-test unixFCmd-13.1 {GetOwnerAttribute - file not found} {
+test unixFCmd-13.1 {GetOwnerAttribute - file not found} {unixOnly notRoot} {
catch {file delete -force -- foo.test}
list [catch {file attributes foo.test -group} msg] $msg
-} {1 {could not stat file "foo.test": no such file or directory}}
-test unixFCmd-13.2 {GetOwnerAttribute} {
+} {1 {could not read "foo.test": no such file or directory}}
+test unixFCmd-13.2 {GetOwnerAttribute} {unixOnly notRoot} {
catch {file delete -force -- foo.test}
close [open foo.test w]
- list [catch {file attributes foo.test -owner} msg] [string compare $msg $user] [file delete -force -- foo.test]
+ list [catch {file attributes foo.test -owner} msg] \
+ [string compare $msg $user] [file delete -force -- foo.test]
} {0 0 {}}
-test unixFCmd-14.1 {GetPermissionsAttribute - file not found} {
+test unixFCmd-14.1 {GetPermissionsAttribute - file not found} {unixOnly notRoot} {
catch {file delete -force -- foo.test}
list [catch {file attributes foo.test -permissions} msg] $msg
-} {1 {could not stat file "foo.test": no such file or directory}}
-test unixFCmd-14.2 {GetPermissionsAttribute} {
+} {1 {could not read "foo.test": no such file or directory}}
+test unixFCmd-14.2 {GetPermissionsAttribute} {unixOnly notRoot} {
catch {file delete -force -- foo.test}
close [open foo.test w]
- list [catch {file attribute foo.test -permissions}] [file delete -force -- foo.test]
+ list [catch {file attribute foo.test -permissions}] \
+ [file delete -force -- foo.test]
} {0 {}}
+# Find a group that exists on this system, or else skip tests that require
+# groups
+set ::tcltest::testConfig(foundGroup) 0
+catch {
+ set groupList [exec groups]
+ set group [lindex $groupList 0]
+ set ::tcltest::testConfig(foundGroup) 1
+}
+
#groups hard to test
-test unixFCmd-15.1 {SetGroupAttribute - invalid group} {
+test unixFCmd-15.1 {SetGroupAttribute - invalid group} {unixOnly notRoot} {
catch {file delete -force -- foo.test}
- list [catch {file attributes foo.test -group foozzz} msg] $msg [file delete -force -- foo.test]
+ list [catch {file attributes foo.test -group foozzz} msg] \
+ $msg [file delete -force -- foo.test]
} {1 {could not set group for file "foo.test": group "foozzz" does not exist} {}}
-test unixFCmd-15.2 {SetGroupAttribute - invalid file} {tclGroup} {
+test unixFCmd-15.2 {SetGroupAttribute - invalid file} \
+ {unixOnly notRoot foundGroup} {
catch {file delete -force -- foo.test}
- list [catch {file attributes foo.test -group tcl} msg] $msg
+ list [catch {file attributes foo.test -group $group} msg] $msg
} {1 {could not set group for file "foo.test": no such file or directory}}
#changing owners hard to do
-test unixFCmd-16.1 {SetOwnerAttribute - current owner} {
+test unixFCmd-16.1 {SetOwnerAttribute - current owner} {unixOnly notRoot} {
catch {file delete -force -- foo.test}
close [open foo.test w]
- list [catch {file attributes foo.test -owner $user} msg] $msg [string compare [file attributes foo.test -owner] $user] [file delete -force -- foo.test]
+ list [catch {file attributes foo.test -owner $user} msg] \
+ $msg [string compare [file attributes foo.test -owner] $user] \
+ [file delete -force -- foo.test]
} {0 {} 0 {}}
-test unixFCmd-16.2 {SetOwnerAttribute - invalid file} {
+test unixFCmd-16.2 {SetOwnerAttribute - invalid file} {unixOnly notRoot} {
catch {file delete -force -- foo.test}
list [catch {file attributes foo.test -owner $user} msg] $msg
} {1 {could not set owner for file "foo.test": no such file or directory}}
-test unixFCmd-16.3 {SetOwnerAttribute - invalid owner} {
+test unixFCmd-16.3 {SetOwnerAttribute - invalid owner} {unixOnly notRoot} {
catch {file delete -force -- foo.test}
list [catch {file attributes foo.test -owner foozzz} msg] $msg
} {1 {could not set owner for file "foo.test": user "foozzz" does not exist}}
-test unixFCmd-17.1 {SetPermissionsAttribute} {
+test unixFCmd-17.1 {SetPermissionsAttribute} {unixOnly notRoot} {
catch {file delete -force -- foo.test}
close [open foo.test w]
- list [catch {file attributes foo.test -permissions 0000} msg] $msg [file attributes foo.test -permissions] [file delete -force -- foo.test]
+ list [catch {file attributes foo.test -permissions 0000} msg] \
+ $msg [file attributes foo.test -permissions] \
+ [file delete -force -- foo.test]
} {0 {} 00000 {}}
-test unixFCmd-17.2 {SetPermissionsAttribute} {
+test unixFCmd-17.2 {SetPermissionsAttribute} {unixOnly notRoot} {
catch {file delete -force -- foo.test}
list [catch {file attributes foo.test -permissions 0000} msg] $msg
} {1 {could not set permissions for file "foo.test": no such file or directory}}
-test unixFCmd-17.3 {SetPermissionsAttribute} {
+test unixFCmd-17.3 {SetPermissionsAttribute} {unixOnly notRoot} {
catch {file delete -force -- foo.test}
close [open foo.test w]
- list [catch {file attributes foo.test -permissions foo} msg] $msg [file delete -force -- foo.test]
+ list [catch {file attributes foo.test -permissions foo} msg] $msg \
+ [file delete -force -- foo.test]
} {1 {expected integer but got "foo"} {}}
-test unixFCmd-18.1 {Unix pwd} {nonPortable} {
+test unixFCmd-18.1 {Unix pwd} {nonPortable unixOnly notRoot} {
# This test is nonportable because SunOS generates a weird error
# message when the current directory isn't readable.
set cd [pwd]
@@ -267,4 +282,19 @@ test unixFCmd-18.1 {Unix pwd} {nonPortable} {
set r
} {1 {error getting working directory name:}}
+# cleanup
cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+