123 lines
3.2 KiB
Plaintext
123 lines
3.2 KiB
Plaintext
# This file tests the tclUnixFCmd.c file.
|
|
#
|
|
# This file contains a collection of tests for one or more of the Tcl
|
|
# built-in commands. Sourcing this file into Tcl runs the tests and
|
|
# generates output for errors. No output means no errors were found.
|
|
#
|
|
# Copyright (c) 1996 Sun Microsystems, Inc.
|
|
#
|
|
# See the file "license.terms" for information on usage and redistribution
|
|
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
|
#
|
|
# SCCS: @(#) unixFCmd.test 1.4 96/10/08 17:12:20
|
|
|
|
if {[string compare test [info procs test]] == 1} then {source defs}
|
|
|
|
if {$tcl_platform(platform) != "unix"} {
|
|
return
|
|
}
|
|
|
|
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
|
|
}
|
|
|
|
proc cleanup {args} {
|
|
foreach p ". $args" {
|
|
set x ""
|
|
catch {
|
|
set x [glob [file join $p tf*] [file join $p td*]]
|
|
}
|
|
if {$x != ""} {
|
|
eval file delete -force -- $x
|
|
}
|
|
}
|
|
}
|
|
|
|
test unixFCmd-1.1 {TclpRenameFile: EACCES} {
|
|
cleanup
|
|
file mkdir td1/td2/td3
|
|
exec chmod 000 td1/td2
|
|
set msg [list [catch {file rename td1/td2/td3 td2} msg] $msg]
|
|
exec chmod 755 td1/td2
|
|
set msg
|
|
} {1 {error renaming "td1/td2/td3": permission denied}}
|
|
test unixFCmd-1.2 {TclpRenameFile: EEXIST} {
|
|
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} {
|
|
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} {
|
|
# can't make it happen
|
|
} {}
|
|
test unixFCmd-1.5 {TclpRenameFile: ENOENT} {
|
|
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} {
|
|
# can't make it happen
|
|
} {}
|
|
test unixFCmd-1.7 {TclpRenameFile: EXDEV} {nonPortable} {
|
|
cleanup
|
|
file mkdir td1
|
|
if [file exists /kernel] {
|
|
set msg [list [catch {file rename /kernel td1} msg] $msg]
|
|
set a1 {1 {can't unlink "/kernel": permission denied}}
|
|
expr {$msg == $a1}
|
|
} else {
|
|
list 1
|
|
}
|
|
} {1}
|
|
|
|
test unixFCmd-2.1 {TclpCopyFile: target exists: lstat(dst) == 0} {
|
|
cleanup
|
|
exec touch tf1
|
|
exec touch tf2
|
|
file copy -force tf1 tf2
|
|
} {}
|
|
test unixFCmd-2.2 {TclpCopyFile: src is symlink} {
|
|
cleanup
|
|
exec ln -s tf1 tf2
|
|
file copy tf2 tf3
|
|
file type tf3
|
|
} {link}
|
|
test unixFCmd-2.3 {TclpCopyFile: src is block} {
|
|
cleanup
|
|
set null "/dev/null"
|
|
while {[file type $null] != "characterSpecial"} {
|
|
set null [file join [file dirname $null] [file readlink $null]]
|
|
}
|
|
# file copy $null tf1
|
|
} {}
|
|
test unixFCmd-2.4 {TclpCopyFile: src is fifo} {
|
|
cleanup
|
|
if [catch {exec mknod tf1 p}] {
|
|
list 1
|
|
} else {
|
|
file copy tf1 tf2
|
|
expr {"[file type tf1]" == "[file type tf2]"}
|
|
}
|
|
} {1}
|
|
test unixFCmd-2.5 {TclpCopyFile: copy attributes} {
|
|
cleanup
|
|
exec touch tf1
|
|
exec chmod 472 tf1
|
|
file copy tf1 tf2
|
|
string range [exec ls -l tf2] 0 9
|
|
} {-r--rwx-w-}
|
|
|
|
cleanup
|
|
|
|
|
|
|
|
|
|
|