home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tcl8.0 / tests / unixFCmd.test < prev    next >
Encoding:
Text File  |  1997-08-15  |  7.9 KB  |  251 lines  |  [TEXT/ALFA]
  1. # This file tests the tclUnixFCmd.c file.
  2. #
  3. # This file contains a collection of tests for one or more of the Tcl
  4. # built-in commands.  Sourcing this file into Tcl runs the tests and
  5. # generates output for errors.  No output means no errors were found.
  6. #
  7. # Copyright (c) 1996 Sun Microsystems, Inc.
  8. #
  9. # See the file "license.terms" for information on usage and redistribution
  10. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  11. #
  12. # SCCS: @(#) unixFCmd.test 1.14 97/08/15 10:22:11
  13.  
  14. if {[string compare test [info procs test]] == 1} then {source defs}
  15.  
  16. if {$tcl_platform(platform) != "unix"} {
  17.     return
  18. }
  19.  
  20. if {$user == "root"} {
  21.     puts "Skipping unixFCmd tests.  They depend on not being able to write to"
  22.     puts "certain directories.  It would be too dangerous to run them as root."
  23.     return
  24. }
  25.  
  26. proc openup {path} {
  27.     testchmod 777 $path
  28.     if {[file isdirectory $path]} {
  29.     catch {
  30.         foreach p [glob [file join $path *]] {
  31.         openup $p
  32.         }
  33.     }
  34.     }
  35. }
  36.  
  37. proc cleanup {args} {
  38.     foreach p ". $args" {
  39.     set x ""
  40.     catch {
  41.         set x [glob [file join $p tf*] [file join $p td*]]
  42.     }
  43.     foreach file $x {
  44.         if {[catch {file delete -force -- $file}]} {
  45.         openup $file
  46.         file delete -force -- $file
  47.         }
  48.     }
  49.     }
  50. }
  51.  
  52. test unixFCmd-1.1 {TclpRenameFile: EACCES} {
  53.     cleanup
  54.     file mkdir td1/td2/td3
  55.     exec chmod 000 td1/td2
  56.     set msg [list [catch {file rename td1/td2/td3 td2} msg] $msg]
  57.     exec chmod 755 td1/td2
  58.     set msg
  59. } {1 {error renaming "td1/td2/td3": permission denied}}
  60. test unixFCmd-1.2 {TclpRenameFile: EEXIST} {
  61.     cleanup
  62.     file mkdir td1/td2
  63.     file mkdir td2
  64.     list [catch {file rename td2 td1} msg] $msg
  65. } {1 {error renaming "td2" to "td1/td2": file already exists}}
  66. test unixFCmd-1.3 {TclpRenameFile: EINVAL} {
  67.     cleanup
  68.     file mkdir td1
  69.     list [catch {file rename td1 td1} msg] $msg
  70. } {1 {error renaming "td1" to "td1/td1": trying to rename a volume or move a directory into itself}}
  71. test unixFCmd-1.4 {TclpRenameFile: EISDIR} {
  72.     # can't make it happen
  73. } {}
  74. test unixFCmd-1.5 {TclpRenameFile: ENOENT} {
  75.     cleanup
  76.     file mkdir td1
  77.     list [catch {file rename td2 td1} msg] $msg
  78. } {1 {error renaming "td2": no such file or directory}}
  79. test unixFCmd-1.6 {TclpRenameFile: ENOTDIR} {
  80.     # can't make it happen
  81. } {}
  82. test unixFCmd-1.7 {TclpRenameFile: EXDEV} {nonPortable} {
  83.     cleanup
  84.     file mkdir td1
  85.     if [file exists /kernel] {
  86.     set msg [list [catch {file rename /kernel td1} msg] $msg]
  87.     set a1 {1 {can't unlink "/kernel": permission denied}}
  88.     expr {$msg == $a1}
  89.     } else {
  90.         list 1
  91.     }
  92. } {1}
  93.  
  94. test unixFCmd-2.1 {TclpCopyFile: target exists: lstat(dst) == 0} {
  95.     cleanup
  96.     exec touch tf1
  97.     exec touch tf2
  98.     file copy -force tf1 tf2
  99. } {}
  100. test unixFCmd-2.2 {TclpCopyFile: src is symlink} {
  101.     cleanup
  102.     exec ln -s tf1 tf2
  103.     file copy tf2 tf3
  104.     file type tf3
  105. } {link}
  106. test unixFCmd-2.3 {TclpCopyFile: src is block} {
  107.     cleanup
  108.     set null "/dev/null"
  109.     while {[file type $null] != "characterSpecial"} {
  110.     set null [file join [file dirname $null] [file readlink $null]]
  111.     }
  112.     # file copy $null tf1
  113. } {}
  114. test unixFCmd-2.4 {TclpCopyFile: src is fifo} {
  115.     cleanup
  116.     if [catch {exec mknod tf1 p}] {
  117.     list 1
  118.     } else {
  119.     file copy tf1 tf2
  120.     expr {"[file type tf1]" == "[file type tf2]"}
  121.     }
  122. } {1}
  123. test unixFCmd-2.5 {TclpCopyFile: copy attributes} {
  124.     cleanup
  125.     exec touch tf1
  126.     exec chmod 472 tf1
  127.     file copy tf1 tf2
  128.     string range [exec ls -l tf2] 0 9
  129. } {-r--rwx-w-}
  130.  
  131. test unixFCmd-3.1 {CopyFile not done} {
  132. } {}
  133.  
  134. test unixFCmd-4.1 {TclpDeleteFile not done} {
  135. } {}
  136.  
  137. test unixFCmd-5.1 {TclpCreateDirectory not done} {
  138. } {}
  139.  
  140. test unixFCmd-6.1 {TclpCopyDirectory not done} {
  141. } {}
  142.  
  143. test unixFCmd-7.1 {TclpRemoveDirectory not done} {
  144. } {}
  145.  
  146. test unixFCmd-8.1 {TraverseUnixTree not done} {
  147. } {}
  148.  
  149. test unixFCmd-9.1 {TraversalCopy not done} {
  150. } {}
  151.  
  152. test unixFCmd-10.1 {TraversalDelete not done} {
  153. } {}
  154.  
  155. test unixFCmd-11.1 {CopyFileAttrs not done} {
  156. } {}
  157.  
  158. set testConfig(tclGroup) 0
  159. if {[catch {exec {groups}} groupList] == 0} {
  160.     if {[lsearch $groupList tcl] != -1} {
  161.     set testConfig(tclGroup) 1
  162.     }
  163. }
  164.  
  165. test unixFCmd-12.1 {GetGroupAttribute - file not found} {
  166.     catch {file delete -force -- foo.test}
  167.     list [catch {file attributes foo.test -group} msg] $msg
  168. } {1 {could not stat file "foo.test": no such file or directory}}
  169. test unixFCmd-12.2 {GetGroupAttribute - file found} {
  170.     catch {file delete -force -- foo.test}
  171.     close [open foo.test w]
  172.     list [catch {file attributes foo.test -group}] [file delete -force -- foo.test]
  173. } {0 {}}
  174.  
  175. test unixFCmd-13.1 {GetOwnerAttribute - file not found} {
  176.     catch {file delete -force -- foo.test}
  177.     list [catch {file attributes foo.test -group} msg] $msg
  178. } {1 {could not stat file "foo.test": no such file or directory}}
  179. test unixFCmd-13.2 {GetOwnerAttribute} {
  180.     catch {file delete -force -- foo.test}
  181.     close [open foo.test w]
  182.     list [catch {file attributes foo.test -owner} msg] [string compare $msg $user] [file delete -force -- foo.test]
  183. } {0 0 {}}
  184.  
  185. test unixFCmd-14.1 {GetPermissionsAttribute - file not found} {
  186.     catch {file delete -force -- foo.test}
  187.     list [catch {file attributes foo.test -permissions} msg] $msg
  188. } {1 {could not stat file "foo.test": no such file or directory}}
  189. test unixFCmd-14.2 {GetPermissionsAttribute} {
  190.     catch {file delete -force -- foo.test}
  191.     close [open foo.test w]
  192.     list [catch {file attribute foo.test -permissions}] [file delete -force -- foo.test]
  193. } {0 {}}
  194.  
  195. #groups hard to test
  196. test unixFCmd-15.1 {SetGroupAttribute - invalid group} {
  197.     catch {file delete -force -- foo.test}
  198.     list [catch {file attributes foo.test -group foozzz} msg] $msg [file delete -force -- foo.test]
  199. } {1 {could not set group for file "foo.test": group "foozzz" does not exist} {}}
  200. test unixFCmd-15.2 {SetGroupAttribute - invalid file} {tclGroup} {
  201.     catch {file delete -force -- foo.test}
  202.     list [catch {file attributes foo.test -group tcl} msg] $msg
  203. } {1 {could not set group for file "foo.test": no such file or directory}}
  204.  
  205. #changing owners hard to do
  206. test unixFCmd-16.1 {SetOwnerAttribute - current owner} {
  207.     catch {file delete -force -- foo.test}
  208.     close [open foo.test w]
  209.     list [catch {file attributes foo.test -owner $user} msg] $msg [string compare [file attributes foo.test -owner] $user] [file delete -force -- foo.test]
  210. } {0 {} 0 {}}
  211. test unixFCmd-16.2 {SetOwnerAttribute - invalid file} {
  212.     catch {file delete -force -- foo.test}
  213.     list [catch {file attributes foo.test -owner $user} msg] $msg
  214. } {1 {could not set owner for file "foo.test": no such file or directory}}
  215. test unixFCmd-16.3 {SetOwnerAttribute - invalid owner} {
  216.     catch {file delete -force -- foo.test}
  217.     list [catch {file attributes foo.test -owner foozzz} msg] $msg
  218. } {1 {could not set owner for file "foo.test": user "foozzz" does not exist}}
  219.  
  220.  
  221. test unixFCmd-17.1 {SetPermissionsAttribute} {
  222.     catch {file delete -force -- foo.test}
  223.     close [open foo.test w]
  224.     list [catch {file attributes foo.test -permissions 0000} msg] $msg [file attributes foo.test -permissions] [file delete -force -- foo.test]
  225. } {0 {} 00000 {}}
  226. test unixFCmd-17.2 {SetPermissionsAttribute} {
  227.     catch {file delete -force -- foo.test}
  228.     list [catch {file attributes foo.test -permissions 0000} msg] $msg
  229. } {1 {could not set permissions for file "foo.test": no such file or directory}}
  230. test unixFCmd-17.3 {SetPermissionsAttribute} {
  231.     catch {file delete -force -- foo.test}
  232.     close [open foo.test w]
  233.     list [catch {file attributes foo.test -permissions foo} msg] $msg [file delete -force -- foo.test]
  234. } {1 {expected integer but got "foo"} {}}
  235. test unixFCmd-18.1 { nix pwd} {nonPortable} {
  236.     # This test is nonportable because SunOS generates a weird error
  237.     # message when the current directory isn't readable.
  238.     set cd [pwd]
  239.     set nd $cd/tstdir
  240.     file mkdir $nd
  241.     cd $nd
  242.     exec chmod 000 $nd
  243.     set r [list [catch {pwd} res] [string range $res 0 36]];
  244.     cd $cd;
  245.     exec chmod 755 $nd
  246.     file delete $nd
  247.     set r
  248. } {1 {error getting working directory name:}}
  249.  
  250. cleanup
  251.