# 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