开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Windows编程 > 通讯编程 > 查看源码
fCmd.test
资源名称：ns-allinone-2.33.tar.gz　[点击查看]
上传用户：rrhhcc
上传日期：2015-12-11
资源大小：54129k
文件大小：77k
源码类别：

通讯编程

开发平台：

Visual C++

fCmd.test：源码内容
  1. # This file tests the tclFCmd.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-1997 Sun Microsystems, Inc.
  8. # Copyright (c) 1999 by Scriptics Corporation.
  9. #
  10. # See the file "license.terms" for information on usage and redistribution
  11. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  12. #
  13. # RCS: @(#) $Id: fCmd.test,v 1.26.2.9 2007/05/17 14:18:42 dgp Exp $
  14. #
  16. if {[lsearch [namespace children] ::tcltest] == -1} {
  17.     package require tcltest 2
  18.     namespace import -force ::tcltest::*
  19. }
  21. tcltest::testConstraint testsetplatform [string equal testsetplatform [info commands testsetplatform]]
  22. tcltest::testConstraint testchmod [string equal testchmod [info commands testchmod]]
  23. tcltest::testConstraint notNetworkFilesystem 0
  24. testConstraint 95or98 [expr {[testConstraint 95] || [testConstraint 98]}]
  25. testConstraint 2000orNewer [expr {![testConstraint 95or98]}]
  27. # Several tests require need to match results against the unix username
  28. set user {}
  29. if {$tcl_platform(platform) == "unix"} {
  30.     catch {set user [exec whoami]}
  31.     if {$user == ""} {
  32. catch {regexp {^[^(]*(([^)]*))} [exec id] dummy user}
  33.     }
  34.     if {$user == ""} {
  35. set user "root"
  36.     }
  37. }
  39. proc createfile {file {string a}} {
  40.     set f [open $file w]
  41.     puts -nonewline $f $string
  42.     close $f
  43.     return $string
  44. }
  46. # 
  47. # checkcontent --
  48. #
  49. #  Ensures that file "file" contains only the string "matchString"
  50. #  returns 0 if the file does not exist, or has a different content
  51. #
  52. proc checkcontent {file matchString} {
  53.     if {[catch {
  54. set f [open $file]
  55. set fileString [read $f]
  56. close $f 
  57.     }]} {
  58. return 0
  59.     }
  60.     return [string match $matchString $fileString]
  61. }
  63. proc openup {path} {
  64.     testchmod 777 $path
  65.     if {[file isdirectory $path]} {
  66. catch {
  67.     foreach p [glob -directory $path *] {
  68. openup $p
  69.     }
  70. }
  71.     }
  72. }
  74. proc cleanup {args} {
  75.     if {$::tcl_platform(platform) == "macintosh"} {
  76. set wd [list :]
  77.     } else {
  78. set wd [list .]
  79.     }
  80.     foreach p [concat $wd $args] {
  81. set x ""
  82. catch {
  83.     set x [glob -directory $p tf* td*]
  84. }
  85. foreach file $x {
  86.     if {[catch {file delete -force -- $file}]} {
  87. catch {openup $file}
  88. catch {file delete -force -- $file}
  89.     }
  90. }
  91.     }
  92. }
  94. proc contents {file} {
  95.     set f [open $file r]
  96.     set r [read $f]
  97.     close $f
  98.     set r
  99. }
  101. cd [temporaryDirectory]
  103. set ::tcltest::testConstraints(fileSharing) 0
  104. set ::tcltest::testConstraints(notFileSharing) 1
  106. if {$tcl_platform(platform) == "macintosh"} {
  107.     catch {file delete -force foo.dir}
  108.     file mkdir foo.dir
  109.     if {[catch {file attributes foo.dir -readonly 1}] == 0} {
  110.      set ::tcltest::testConstraints(fileSharing) 1
  111.      set ::tcltest::testConstraints(notFileSharing) 0
  112.     }
  113.     file delete -force foo.dir
  114. }
  116. set ::tcltest::testConstraints(xdev) 0
  118. if {$tcl_platform(platform) == "unix"} {
  119.     if {[catch {set m1 [exec df .]; set m2 [exec df /tmp]}] == 0} {
  120. set m1 [string range $m1 0 [expr [string first " " $m1]-1]]
  121. set m2 [string range $m2 0 [expr [string first " " $m2]-1]]
  122. if {$m1 != "" && $m2 != "" && $m1 != $m2 && [file exists $m1] && [file exists $m2]} {
  123.     set ::tcltest::testConstraints(xdev) 1
  124. }
  125.     }
  126. }
  128. set root [lindex [file split [pwd]] 0]
  130. # A really long file name
  131. # length of long is 1216 chars, which should be greater than any static
  132. # buffer or allowable filename.
  134. set long "abcdefghihjllmnopqrstuvwxyz01234567890"
  135. append long $long
  136. append long $long
  137. append long $long
  138. append long $long
  139. append long $long
  141. test fCmd-1.1 {TclFileRenameCmd} {notRoot} {
  142.     cleanup
  143.     createfile tf1
  144.     file rename tf1 tf2
  145.     glob tf*
  146. } {tf2}
  148. test fCmd-2.1 {TclFileCopyCmd} {notRoot} {
  149.     cleanup
  150.     createfile tf1
  151.     file copy tf1 tf2
  152.     lsort [glob tf*]
  153. } {tf1 tf2}
  155. test fCmd-3.1 {FileCopyRename: FileForceOption fails} {notRoot} {
  156.     list [catch {file rename -xyz} msg] $msg
  157. } {1 {bad option "-xyz": should be -force or --}}
  158. test fCmd-3.2 {FileCopyRename: not enough args} {notRoot} {
  159.     list [catch {file rename xyz} msg] $msg
  160. } {1 {wrong # args: should be "file rename ?options? source ?source ...? target"}}
  161. test fCmd-3.3 {FileCopyRename: Tcl_TranslateFileName fails} {notRoot} {
  162.     list [catch {file rename xyz ~_totally_bogus_user} msg] $msg
  163. } {1 {user "_totally_bogus_user" doesn't exist}}
  164. test fCmd-3.4 {FileCopyRename: Tcl_TranslateFileName passes} {notRoot} {
  165.     cleanup
  166.     list [catch {file copy tf1 ~} msg] $msg
  167. } {1 {error copying "tf1": no such file or directory}}
  168. test fCmd-3.5 {FileCopyRename: target doesn't exist: stat(target) != 0} {notRoot} {
  169.     cleanup
  170.     list [catch {file rename tf1 tf2 tf3} msg] $msg
  171. } {1 {error renaming: target "tf3" is not a directory}}
  172. test fCmd-3.6 {FileCopyRename: target tf3 is not a dir: !S_ISDIR(target)} 
  173. {notRoot} {
  174.     cleanup
  175.     createfile tf3
  176.     list [catch {file rename tf1 tf2 tf3} msg] $msg
  177. } {1 {error renaming: target "tf3" is not a directory}}
  178. test fCmd-3.7 {FileCopyRename: target exists & is directory} {notRoot} {
  179.     cleanup
  180.     file mkdir td1
  181.     createfile tf1 tf1
  182.     file rename tf1 td1
  183.     contents [file join td1 tf1]
  184. } {tf1}
  185. test fCmd-3.8 {FileCopyRename: too many arguments: argc - i > 2} {notRoot} {
  186.     cleanup
  187.     list [catch {file rename tf1 tf2 tf3} msg] $msg
  188. } {1 {error renaming: target "tf3" is not a directory}}
  189. test fCmd-3.9 {FileCopyRename: too many arguments: argc - i > 2} {notRoot} {
  190.     cleanup
  191.     list [catch {file copy -force -- tf1 tf2 tf3} msg] $msg
  192. } {1 {error copying: target "tf3" is not a directory}}
  193. test fCmd-3.10 {FileCopyRename: just 2 arguments} {notRoot} {
  194.     cleanup
  195.     createfile tf1 tf1
  196.     file rename tf1 tf2
  197.     contents tf2
  198. } {tf1}
  199. test fCmd-3.11 {FileCopyRename: just 2 arguments} {notRoot} {
  200.     cleanup
  201.     createfile tf1 tf1
  202.     file rename -force -force -- tf1 tf2
  203.     contents tf2
  204. } {tf1}
  205. test fCmd-3.12 {FileCopyRename: move each source: 1 source} {notRoot} {
  206.     cleanup
  207.     createfile tf1 tf1
  208.     file mkdir td1
  209.     file rename tf1 td1
  210.     contents [file join td1 tf1]
  211. } {tf1}
  212. test fCmd-3.13 {FileCopyRename: move each source: multiple sources} {notRoot} {
  213.     cleanup
  214.     createfile tf1 tf1
  215.     createfile tf2 tf2
  216.     createfile tf3 tf3
  217.     createfile tf4 tf4
  218.     file mkdir td1
  219.     file rename tf1 tf2 tf3 tf4 td1
  220.     list [contents [file join td1 tf1]] [contents [file join td1 tf2]] 
  221. [contents [file join td1 tf3]] [contents [file join td1 tf4]]
  222. } {tf1 tf2 tf3 tf4}
  223. test fCmd-3.14 {FileCopyRename: FileBasename fails} {notRoot} {
  224.     cleanup
  225.     file mkdir td1
  226.     list [catch {file rename ~_totally_bogus_user td1} msg] $msg
  227. } {1 {user "_totally_bogus_user" doesn't exist}}
  228. test fCmd-3.15 {FileCopyRename: source[0] == ''} {notRoot unixOrPc} {
  229.     cleanup
  230.     file mkdir td1
  231.     list [catch {file rename / td1} msg] $msg
  232. } {1 {error renaming "/" to "td1": file already exists}}
  233. test fCmd-3.16 {FileCopyRename: break on first error} {notRoot} {
  234.     cleanup
  235.     createfile tf1 
  236.     createfile tf2 
  237.     createfile tf3 
  238.     createfile tf4 
  239.     file mkdir td1
  240.     createfile [file join td1 tf3]
  241.     list [catch {file rename tf1 tf2 tf3 tf4 td1} msg] $msg
  242. } [subst {1 {error renaming "tf3" to "[file join td1 tf3]": file already exists}}]
  244. test fCmd-4.1 {TclFileMakeDirsCmd: make each dir: 1 dir} {notRoot} {
  245.     cleanup
  246.     file mkdir td1
  247.     glob td*
  248. } {td1}
  249. test fCmd-4.2 {TclFileMakeDirsCmd: make each dir: multiple dirs} {notRoot} {
  250.     cleanup
  251.     file mkdir td1 td2 td3
  252.     lsort [glob td*]
  253. } {td1 td2 td3}
  254. test fCmd-4.3 {TclFileMakeDirsCmd: stops on first error} {notRoot} {
  255.     cleanup
  256.     createfile tf1
  257.     catch {file mkdir td1 td2 tf1 td3 td4}
  258.     glob td1 td2 tf1 td3 td4
  259. } {td1 td2 tf1}
  260. test fCmd-4.4 {TclFileMakeDirsCmd: Tcl_TranslateFileName fails} {notRoot} {
  261.     cleanup
  262.     list [catch {file mkdir ~_totally_bogus_user} msg] $msg
  263. } {1 {user "_totally_bogus_user" doesn't exist}}
  264. test fCmd-4.5 {TclFileMakeDirsCmd: Tcl_SplitPath returns 0: *name == ''} 
  265. {notRoot} {
  266.     cleanup
  267.     list [catch {file mkdir ""} msg] $msg
  268. } {1 {can't create directory "": no such file or directory}}
  269. test fCmd-4.6 {TclFileMakeDirsCmd: one level deep} {notRoot} {
  270.     cleanup
  271.     file mkdir td1
  272.     glob td1
  273. } {td1}
  274. test fCmd-4.7 {TclFileMakeDirsCmd: multi levels deep} {notRoot} {
  275.     cleanup
  276.     file mkdir [file join td1 td2 td3 td4]
  277.     glob td1 [file join td1 td2]
  278. } "td1 [file join td1 td2]"
  279. test fCmd-4.8 {TclFileMakeDirsCmd: already exist: lstat(target) == 0} {notRoot} {
  280.     cleanup
  281.     file mkdir td1
  282.     set x [file exists td1]
  283.     file mkdir td1
  284.     list $x [file exists td1]
  285. } {1 1}
  286. test fCmd-4.9 {TclFileMakeDirsCmd: exists, not dir} {notRoot} {
  287.     cleanup
  288.     createfile tf1
  289.     list [catch {file mkdir tf1} msg] $msg
  290. } [subst {1 {can't create directory "[file join tf1]": file already exists}}]
  291. test fCmd-4.10 {TclFileMakeDirsCmd: exists, is dir} {notRoot} {
  292.     cleanup
  293.     file mkdir td1
  294.     set x [file exists td1]
  295.     file mkdir td1
  296.     list $x [file exists td1]
  297. } {1 1}
  298. test fCmd-4.11 {TclFileMakeDirsCmd: doesn't exist: errno != ENOENT} 
  299. {unixOnly notRoot testchmod} {
  300.     cleanup
  301.     file mkdir td1/td2/td3
  302.     testchmod 000 td1/td2
  303.     set msg [list [catch {file mkdir td1/td2/td3/td4} msg] $msg]
  304.     testchmod 755 td1/td2
  305.     set msg
  306. } {1 {can't create directory "td1/td2/td3": permission denied}}
  307. test fCmd-4.12 {TclFileMakeDirsCmd: doesn't exist: errno != ENOENT} {macOnly} {
  308.     cleanup
  309.     list [catch {file mkdir nonexistentvolume:} msg] $msg
  310. } {1 {can't create directory "nonexistentvolume:": invalid argument}}
  311. test fCmd-4.13 {TclFileMakeDirsCmd: doesn't exist: errno == ENOENT} {notRoot} {
  312.     cleanup
  313.     set x [file exists td1]
  314.     file mkdir td1
  315.     list $x [file exists td1]
  316. } {0 1}
  317. test fCmd-4.14 {TclFileMakeDirsCmd: TclpCreateDirectory fails} 
  318. {unixOnly notRoot} {
  319.     cleanup
  320.     file delete -force foo
  321.     file mkdir foo
  322.     file attr foo -perm 040000
  323.     set result [list [catch {file mkdir foo/tf1} msg] $msg]
  324.     file delete -force foo
  325.     set result
  326. } {1 {can't create directory "foo/tf1": permission denied}}
  327. test fCmd-4.15 {TclFileMakeDirsCmd: TclpCreateDirectory fails} {macOnly} {
  328.     list [catch {file mkdir ${root}:} msg] $msg
  329. } [subst {1 {can't create directory "${root}:": no such file or directory}}]
  330. test fCmd-4.16 {TclFileMakeDirsCmd: TclpCreateDirectory succeeds} {notRoot} {
  331.     cleanup
  332.     file mkdir tf1
  333.     file exists tf1
  334. } {1}
  336. test fCmd-5.1 {TclFileDeleteCmd: FileForceOption fails} {notRoot} {
  337.     list [catch {file delete -xyz} msg] $msg
  338. } {1 {bad option "-xyz": should be -force or --}}
  339. test fCmd-5.2 {TclFileDeleteCmd: not enough args} {notRoot} {
  340.     list [catch {file delete -force -force} msg] $msg
  341. } {1 {wrong # args: should be "file delete ?options? file ?file ...?"}}
  342. test fCmd-5.3 {TclFileDeleteCmd: 1 file} {notRoot} {
  343.     cleanup
  344.     createfile tf1
  345.     createfile tf2
  346.     file mkdir td1
  347.     file delete tf2
  348.     glob tf* td*
  349. } {tf1 td1}
  350. test fCmd-5.4 {TclFileDeleteCmd: multiple files} {notRoot} {
  351.     cleanup
  352.     createfile tf1
  353.     createfile tf2
  354.     file mkdir td1
  355.     set x [list [file exists tf1] [file exists tf2] [file exists td1]]
  356.     file delete tf1 td1 tf2
  357.     lappend x [file exists tf1] [file exists tf2] [file exists tf3]
  358. } {1 1 1 0 0 0}
  359. test fCmd-5.5 {TclFileDeleteCmd: stop at first error} {notRoot unixOrPc} {
  360.     cleanup
  361.     createfile tf1
  362.     createfile tf2
  363.     file mkdir td1
  364.     catch {file delete tf1 td1 $root tf2}
  365.     list [file exists tf1] [file exists tf2] [file exists td1]
  366. } {0 1 0}
  367. test fCmd-5.6 {TclFileDeleteCmd: Tcl_TranslateFileName fails} {notRoot} {
  368.     list [catch {file delete ~_totally_bogus_user} msg] $msg
  369. } {1 {user "_totally_bogus_user" doesn't exist}}
  370. test fCmd-5.7 {TclFileDeleteCmd: Tcl_TranslateFileName succeeds} {notRoot} {
  371.     catch {file delete ~/tf1}
  372.     createfile ~/tf1
  373.     file delete ~/tf1
  374. } {}
  375. test fCmd-5.8 {TclFileDeleteCmd: file doesn't exist: lstat(name) != 0} {notRoot} {
  376.     cleanup
  377.     set x [file exists tf1]
  378.     file delete tf1
  379.     list $x [file exists tf1]
  380. } {0 0}    
  381. test fCmd-5.9 {TclFileDeleteCmd: is directory} {notRoot} {
  382.     cleanup
  383.     file mkdir td1
  384.     file delete td1
  385.     file exists td1
  386. } {0}
  387. test fCmd-5.10 {TclFileDeleteCmd: TclpRemoveDirectory fails} {notRoot} {
  388.     cleanup
  389.     file mkdir [file join td1 td2]
  390.     list [catch {file delete td1} msg] $msg
  391. } {1 {error deleting "td1": directory not empty}}
  392. test fCmd-5.11 {TclFileDeleteCmd: TclpRemoveDirectory with cwd inside} {notRoot} {
  393.     cleanup
  394.     set dir [pwd]
  395.     file mkdir [file join td1 td2]
  396.     cd [file join td1 td2]
  397.     set res [list [catch {file delete -force [file dirname [pwd]]} msg]]
  398.     cd $dir
  399.     lappend res [file exists td1] $msg
  400. } {0 0 {}}
  401. test fCmd-5.12 {TclFileDeleteCmd: TclpRemoveDirectory with bad perms} {unixOnly} {
  402.     cleanup
  403.     file mkdir [file join td1 td2]
  404.     #exec chmod u-rwx [file join td1 td2]
  405.     file attributes [file join td1 td2] -permissions u+rwx
  406.     set res [list [catch {file delete -force td1} msg]]
  407.     lappend res [file exists td1] $msg
  408. } {0 0 {}}
  410. test fCmd-6.1 {CopyRenameOneFile: bad source} {notRoot} {
  411.     # can't test this, because it's caught by FileCopyRename
  412. } {}
  413. test fCmd-6.2 {CopyRenameOneFile: bad target} {notRoot} {
  414.     # can't test this, because it's caught by FileCopyRename
  415. } {}
  416. test fCmd-6.3 {CopyRenameOneFile: lstat(source) != 0} {notRoot} {
  417.     cleanup
  418.     list [catch {file rename tf1 tf2} msg] $msg
  419. } {1 {error renaming "tf1": no such file or directory}}
  420. test fCmd-6.4 {CopyRenameOneFile: lstat(source) == 0} {notRoot} {
  421.     cleanup
  422.     createfile tf1
  423.     file rename tf1 tf2
  424.     glob tf*
  425. } {tf2}
  426. test fCmd-6.5 {CopyRenameOneFile: lstat(target) != 0} {notRoot} {
  427.     cleanup
  428.     createfile tf1
  429.     file rename tf1 tf2
  430.     glob tf*
  431. } {tf2}
  432. test fCmd-6.6 {CopyRenameOneFile: errno != ENOENT} {unixOnly notRoot testchmod} {
  433.     cleanup
  434.     file mkdir td1
  435.     testchmod 000 td1
  436.     createfile tf1
  437.     set msg [list [catch {file rename tf1 td1} msg] $msg]
  438.     testchmod 755 td1
  439.     set msg
  440. } {1 {error renaming "tf1" to "td1/tf1": permission denied}}
  441. test fCmd-6.7 {CopyRenameOneFile: errno != ENOENT} {pcOnly 95} {
  442.     cleanup
  443.     createfile tf1
  444.     list [catch {file rename tf1 $long} msg] $msg
  445. } [subst {1 {error renaming "tf1" to "$long": file name too long}}]
  446. test fCmd-6.8 {CopyRenameOneFile: errno != ENOENT} {macOnly} {
  447.     cleanup
  448.     createfile tf1
  449.     list [catch {file rename tf1 $long} msg] $msg
  450. } [subst {1 {error renaming "tf1" to "$long": file name too long}}]
  451. test fCmd-6.9 {CopyRenameOneFile: errno == ENOENT} {unixOnly notRoot} {
  452.     cleanup
  453.     createfile tf1
  454.     file rename tf1 tf2
  455.     glob tf*
  456. } {tf2}
  457. test fCmd-6.10 {CopyRenameOneFile: lstat(target) == 0} {notRoot} {
  458.     cleanup
  459.     createfile tf1
  460.     createfile tf2
  461.     list [catch {file rename tf1 tf2} msg] $msg
  462. } {1 {error renaming "tf1" to "tf2": file already exists}}
  463. test fCmd-6.11 {CopyRenameOneFile: force == 0} {notRoot} {
  464.     cleanup
  465.     createfile tf1
  466.     createfile tf2
  467.     list [catch {file rename tf1 tf2} msg] $msg
  468. } {1 {error renaming "tf1" to "tf2": file already exists}}
  469. test fCmd-6.12 {CopyRenameOneFile: force != 0} {notRoot} {
  470.     cleanup
  471.     createfile tf1
  472.     createfile tf2
  473.     file rename -force tf1 tf2
  474.     glob tf*
  475. } {tf2}
  476. test fCmd-6.13 {CopyRenameOneFile: source is dir, target is file} {notRoot} {
  477.     cleanup
  478.     file mkdir td1
  479.     file mkdir td2
  480.     createfile [file join td2 td1]
  481.     list [catch {file rename -force td1 td2} msg] $msg
  482. } [subst {1 {can't overwrite file "[file join td2 td1]" with directory "td1"}}]
  483. test fCmd-6.14 {CopyRenameOneFile: source is file, target is dir} {notRoot} {
  484.     cleanup
  485.     createfile tf1
  486.     file mkdir [file join td1 tf1]
  487.     list [catch {file rename -force tf1 td1} msg] $msg
  488. } [subst {1 {can't overwrite directory "[file join td1 tf1]" with file "tf1"}}]
  489. test fCmd-6.15 {CopyRenameOneFile: TclpRenameFile succeeds} {notRoot notNetworkFilesystem} {
  490.     cleanup
  491.     file mkdir [file join td1 td2]
  492.     file mkdir td2
  493.     createfile [file join td2 tf1]
  494.     file rename -force td2 td1
  495.     file exists [file join td1 td2 tf1]
  496. } {1}
  497. test fCmd-6.16 {CopyRenameOneFile: TclpCopyRenameOneFile fails} {notRoot} {
  498.     cleanup
  499.     file mkdir [file join td1 td2]
  500.     createfile [file join td1 td2 tf1]
  501.     file mkdir td2
  502.     list [catch {file rename -force td2 td1} msg] $msg
  503. } [subst {1 {error renaming "td2" to "[file join td1 td2]": file already exists}}]
  505. test fCmd-6.17 {CopyRenameOneFile: errno == EINVAL} {notRoot} {
  506.     cleanup
  507.     list [catch {file rename -force $root tf1} msg] $msg
  508. } [subst {1 {error renaming "$root" to "tf1": trying to rename a volume or move a directory into itself}}]
  509. test fCmd-6.18 {CopyRenameOneFile: errno != EXDEV} {notRoot} {
  510.     cleanup
  511.     file mkdir [file join td1 td2]
  512.     createfile [file join td1 td2 tf1]
  513.     file mkdir td2
  514.     list [catch {file rename -force td2 td1} msg] $msg
  515. } [subst {1 {error renaming "td2" to "[file join td1 td2]": file already exists}}]
  516. test fCmd-6.19 {CopyRenameOneFile: errno == EXDEV} {unixOnly notRoot} {
  517.     cleanup /tmp
  518.     createfile tf1
  519.     file rename tf1 /tmp
  520.     glob tf* /tmp/tf1
  521. } {/tmp/tf1}
  522. test fCmd-6.20 {CopyRenameOneFile: errno == EXDEV} {pcOnly} {
  523.     catch {file delete -force c:/tcl8975@ d:/tcl8975@}
  524.     file mkdir c:/tcl8975@
  525.     if [catch {file rename c:/tcl8975@ d:/}] {
  526. set msg d:/tcl8975@
  527.     } else {
  528. set msg [glob c:/tcl8975@ d:/tcl8975@]
  529. file delete -force d:/tcl8975@
  530.     }
  531.     file delete -force c:/tcl8975@
  532.     set msg
  533. } {d:/tcl8975@}
  534. test fCmd-6.21 {CopyRenameOneFile: copy/rename: S_ISDIR(source)} 
  535. {unixOnly notRoot} {
  536.     cleanup /tmp
  537.     file mkdir td1
  538.     file rename td1 /tmp
  539.     glob td* /tmp/td*
  540. } {/tmp/td1}
  541. test fCmd-6.22 {CopyRenameOneFile: copy/rename: !S_ISDIR(source)} 
  542. {unixOnly notRoot} {
  543.     cleanup /tmp
  544.     createfile tf1
  545.     file rename tf1 /tmp
  546.     glob tf* /tmp/tf*
  547. } {/tmp/tf1}
  548. test fCmd-6.23 {CopyRenameOneFile: TclpCopyDirectory failed} 
  549. {unixOnly notRoot xdev} {
  550.     cleanup /tmp
  551.     file mkdir td1/td2/td3
  552.     file attributes td1 -permissions 0000
  553.     set msg [list [catch {file rename td1 /tmp} msg] $msg]
  554.     file attributes td1 -permissions 0755
  555.     set msg 
  556. } {1 {error renaming "td1": permission denied}}
  557. test fCmd-6.24 {CopyRenameOneFile: error uses original name} 
  558. {unixOnly notRoot} {
  559.     cleanup
  560.     file mkdir ~/td1/td2
  561.     set td1name [file join [file dirname ~] [file tail ~] td1]
  562.     file attributes $td1name -permissions 0000
  563.     set msg [list [catch {file copy ~/td1 td1} msg] $msg]
  564.     file attributes $td1name -permissions 0755
  565.     file delete -force ~/td1
  566.     set msg
  567. } {1 {error copying "~/td1": permission denied}}
  568. test fCmd-6.25 {CopyRenameOneFile: error uses original name} 
  569. {unixOnly notRoot} {
  570.     cleanup
  571.     file mkdir td2
  572.     file mkdir ~/td1
  573.     set td1name [file join [file dirname ~] [file tail ~] td1]
  574.     file attributes $td1name -permissions 0000
  575.     set msg [list [catch {file copy td2 ~/td1} msg] $msg]
  576.     file attributes $td1name -permissions 0755
  577.     file delete -force ~/td1
  578.     set msg
  579. } {1 {error copying "td2" to "~/td1/td2": permission denied}}
  580. test fCmd-6.26 {CopyRenameOneFile: doesn't use original name} 
  581. {unixOnly notRoot} {
  582.     cleanup
  583.     file mkdir ~/td1/td2
  584.     set td2name [file join [file dirname ~] [file tail ~] td1 td2]
  585.     file attributes $td2name -permissions 0000
  586.     set msg [list [catch {file copy ~/td1 td1} msg] $msg]
  587.     file attributes $td2name -permissions 0755
  588.     file delete -force ~/td1
  589.     set msg
  590. } "1 {error copying "~/td1" to "td1": "[file join [file dirname ~] [file tail ~] td1 td2]": permission denied}"
  591. test fCmd-6.27 {CopyRenameOneFile: TclpCopyDirectory failed} 
  592. {unixOnly notRoot xdev} {
  593.     cleanup /tmp
  594.     file mkdir td1/td2/td3
  595.     file mkdir /tmp/td1
  596.     createfile /tmp/td1/tf1
  597.     list [catch {file rename -force td1 /tmp} msg] $msg
  598. } {1 {error renaming "td1" to "/tmp/td1": file already exists}}
  599. test fCmd-6.28 {CopyRenameOneFile: TclpCopyDirectory failed} 
  600. {unixOnly notRoot xdev} {
  601.     cleanup /tmp
  602.     file mkdir td1/td2/td3
  603.     file attributes td1/td2/td3 -permissions 0000
  604.     set msg [list [catch {file rename td1 /tmp} msg] $msg]
  605.     file attributes td1/td2/td3 -permissions 0755
  606.     set msg
  607. } {1 {error renaming "td1" to "/tmp/td1": "td1/td2/td3": permission denied}}
  608. test fCmd-6.29 {CopyRenameOneFile: TclpCopyDirectory passed} 
  609. {unixOnly notRoot xdev} {
  610.     cleanup /tmp
  611.     file mkdir td1/td2/td3
  612.     file rename td1 /tmp
  613.     glob td* /tmp/td1/t*
  614. } {/tmp/td1/td2}
  615. test fCmd-6.30 {CopyRenameOneFile: TclpRemoveDirectory failed} 
  616. {unixOnly notRoot} {
  617.     cleanup
  618.     file mkdir foo/bar
  619.     file attr foo -perm 040555
  620.     set catchResult [catch {file rename foo/bar /tmp} msg]
  621.     set msg [lindex [split $msg :] end]
  622.     catch {file delete /tmp/bar}
  623.     catch {file attr foo -perm 040777}
  624.     catch {file delete -force foo}
  625.     list $catchResult $msg
  626. } {1 { permission denied}}
  627. test fCmd-6.31 {CopyRenameOneFile: TclpDeleteFile passed} 
  628. {unixOnly notRoot xdev} {
  629.     catch {cleanup /tmp}
  630.     file mkdir /tmp/td1
  631.     createfile /tmp/td1/tf1
  632.     file rename /tmp/td1/tf1 tf1
  633.     list [file exists /tmp/td1/tf1] [file exists tf1]
  634. } {0 1}
  635. test fCmd-6.32 {CopyRenameOneFile: copy} {notRoot} {
  636.     cleanup
  637.     list [catch {file copy tf1 tf2} msg] $msg
  638. } {1 {error copying "tf1": no such file or directory}}
  639. catch {cleanup /tmp}
  641. test fCmd-7.1 {FileForceOption: none} {notRoot} {
  642.     cleanup
  643.     file mkdir [file join tf1 tf2]
  644.     list [catch {file delete tf1} msg] $msg
  645. } {1 {error deleting "tf1": directory not empty}}
  646. test fCmd-7.2 {FileForceOption: -force} {notRoot} {
  647.     cleanup
  648.     file mkdir [file join tf1 tf2]
  649.     file delete -force tf1
  650. } {}
  651. test fCmd-7.3 {FileForceOption: --} {notRoot} {
  652.     createfile -tf1
  653.     file delete -- -tf1
  654. } {}
  655. test fCmd-7.4 {FileForceOption: bad option} {notRoot} {
  656.     createfile -tf1
  657.     set msg [list [catch {file delete -tf1} msg] $msg]
  658.     file delete -- -tf1
  659.     set msg
  660. } {1 {bad option "-tf1": should be -force or --}}
  661. test fCmd-7.5 {FileForceOption: multiple times through loop} {notRoot} {
  662.     createfile --
  663.     createfile -force
  664.     file delete -force -force -- -- -force
  665.     list [catch {glob -- -- -force} msg] $msg
  666. } {1 {no files matched glob patterns "-- -force"}}
  668. test fCmd-8.1 {FileBasename: basename of ~user: argc == 1 && *path == ~} 
  669. {unixOnly notRoot knownBug} {
  670.     # Labelled knownBug because it is dangerous [Bug: 3881]
  671.     file mkdir td1
  672.     file attr td1 -perm 040000
  673.     set result [list [catch {file rename ~$user td1} msg] $msg]
  674.     file delete -force td1
  675.     set result
  676. } "1 {error renaming "~$user" to "td1/[file tail ~$user]": permission denied}"
  677. test fCmd-8.2 {FileBasename: basename of ~user: argc == 1 && *path == ~} {
  678.     string equal [file tail ~$user] ~$user
  679. } 0
  680. test fCmd-8.3 {file copy and path translation: ensure correct error} {
  681.     list [catch {file copy ~ [file join this file doesnt exist]} res] $res
  682. } [list 1 
  683.   "error copying "~" to "[file join this file doesnt exist]":
  684.   no such file or directory"]
  686. test fCmd-9.1 {file rename: comprehensive: EACCES} {unixOnly notRoot} {
  687.     cleanup
  688.     file mkdir td1
  689.     file mkdir td2
  690.     file attr td2 -perm 040000
  691.     set result [list [catch {file rename td1 td2/} msg] $msg]
  692.     file delete -force td2
  693.     file delete -force td1
  694.     set result
  695. } {1 {error renaming "td1" to "td2/td1": permission denied}}
  696. test fCmd-9.2 {file rename: comprehensive: source doesn't exist} {notRoot} {
  697.     cleanup
  698.     list [catch {file rename tf1 tf2} msg] $msg
  699. } {1 {error renaming "tf1": no such file or directory}}
  700. test fCmd-9.3 {file rename: comprehensive: file to new name} {notRoot testchmod} {
  701.     cleanup
  702.     createfile tf1
  703.     createfile tf2
  704.     testchmod 444 tf2
  705.     file rename tf1 tf3
  706.     file rename tf2 tf4
  707.     list [lsort [glob tf*]] [file writable tf3] [file writable tf4]
  708. } {{tf3 tf4} 1 0}    
  709. test fCmd-9.4 {file rename: comprehensive: dir to new name} {unixOrPc notRoot testchmod} {
  710.     cleanup
  711.     file mkdir td1 td2
  712.     testchmod 555 td2
  713.     file rename td1 td3
  714.     file rename td2 td4
  715.     list [lsort [glob td*]] [file writable td3] [file writable td4]
  716. } {{td3 td4} 1 0}    
  717. test fCmd-9.5 {file rename: comprehensive: file to self} {notRoot testchmod} {
  718.     cleanup
  719.     createfile tf1 tf1
  720.     createfile tf2 tf2
  721.     testchmod 444 tf2
  722.     file rename -force tf1 tf1
  723.     file rename -force tf2 tf2
  724.     list [contents tf1] [contents tf2] [file writable tf1] [file writable tf2]
  725. } {tf1 tf2 1 0}    
  726. test fCmd-9.6 {file rename: comprehensive: dir to self} {notRoot unixOrPc testchmod} {
  727.     cleanup
  728.     file mkdir td1
  729.     file mkdir td2
  730.     testchmod 555 td2
  731.     file rename -force td1 .
  732.     file rename -force td2 .
  733.     list [lsort [glob td*]] [file writable td1] [file writable td2]
  734. } {{td1 td2} 1 0}    
  735. test fCmd-9.7 {file rename: comprehensive: file to existing file} {notRoot testchmod} {
  736.     cleanup
  737.     createfile tf1
  738.     createfile tf2
  739.     createfile tfs1
  740.     createfile tfs2
  741.     createfile tfs3
  742.     createfile tfs4
  743.     createfile tfd1
  744.     createfile tfd2
  745.     createfile tfd3
  746.     createfile tfd4
  747.     testchmod 444 tfs3
  748.     testchmod 444 tfs4
  749.     testchmod 444 tfd2
  750.     testchmod 444 tfd4
  751.     set msg [list [catch {file rename tf1 tf2} msg] $msg]
  752.     file rename -force tfs1 tfd1
  753.     file rename -force tfs2 tfd2
  754.     file rename -force tfs3 tfd3
  755.     file rename -force tfs4 tfd4
  756.     list [lsort [glob tf*]] $msg [file writable tfd1] [file writable tfd2] [file writable tfd3] [file writable tfd4] 
  757. } {{tf1 tf2 tfd1 tfd2 tfd3 tfd4} {1 {error renaming "tf1" to "tf2": file already exists}} 1 1 0 0}
  758. test fCmd-9.8 {file rename: comprehensive: dir to empty dir} {notRoot testchmod notNetworkFilesystem} {
  759.     # Under unix, you can rename a read-only directory, but you can't
  760.     # move it into another directory.
  762.     cleanup
  763.     file mkdir td1
  764.     file mkdir [file join td2 td1]
  765.     file mkdir tds1
  766.     file mkdir tds2
  767.     file mkdir tds3
  768.     file mkdir tds4
  769.     file mkdir [file join tdd1 tds1]
  770.     file mkdir [file join tdd2 tds2]
  771.     file mkdir [file join tdd3 tds3]
  772.     file mkdir [file join tdd4 tds4]
  773.     if {$tcl_platform(platform) != "unix" && $tcl_platform(platform) != "macintosh"} {
  774. testchmod 555 tds3
  775. testchmod 555 tds4
  776.     }
  777.     if {$tcl_platform(platform) != "macintosh"} {
  778.      testchmod 555 [file join tdd2 tds2]
  779.      testchmod 555 [file join tdd4 tds4]
  780.     }
  781.     set msg [list [catch {file rename td1 td2} msg] $msg]
  782.     file rename -force tds1 tdd1
  783.     file rename -force tds2 tdd2
  784.     file rename -force tds3 tdd3
  785.     file rename -force tds4 tdd4
  786.     if {$tcl_platform(platform) != "unix" && $tcl_platform(platform) != "macintosh"} {
  787. set w3 [file writable [file join tdd3 tds3]]
  788. set w4 [file writable [file join tdd4 tds4]]
  789.     } else {
  790. set w3 0
  791. set w4 0
  792.     }
  793.     list [lsort [glob td*]] $msg [file writable [file join tdd1 tds1]] 
  794.     [file writable [file join tdd2 tds2]] $w3 $w4
  795. } [subst {{td1 td2 tdd1 tdd2 tdd3 tdd4} {1 {error renaming "td1" to "[file join td2 td1]": file already exists}} 1 1 0 0}]
  796. test fCmd-9.9 {file rename: comprehensive: dir to non-empty dir} {notRoot testchmod} {
  797.     cleanup
  798.     file mkdir tds1
  799.     file mkdir tds2
  800.     file mkdir [file join tdd1 tds1 xxx]
  801.     file mkdir [file join tdd2 tds2 xxx]
  802.     if {$tcl_platform(platform) != "unix" && $tcl_platform(platform) != "macintosh"} {
  803. testchmod 555 tds2
  804.     }
  805.     set a1 [list [catch {file rename -force tds1 tdd1} msg] $msg]
  806.     set a2 [list [catch {file rename -force tds2 tdd2} msg] $msg]
  807.     if {$tcl_platform(platform) != "unix" && $tcl_platform(platform) != "macintosh"} {
  808. set w2 [file writable tds2]
  809.     } else {
  810. set w2 0
  811.     }
  812.     list [lsort [glob td*]] $a1 $a2 [file writable tds1] $w2
  813. } [subst {{tdd1 tdd2 tds1 tds2} {1 {error renaming "tds1" to "[file join tdd1 tds1]": file already exists}} {1 {error renaming "tds2" to "[file join tdd2 tds2]": file already exists}} 1 0}]
  814. test fCmd-9.10 {file rename: comprehensive: file to new name and dir} {notRoot testchmod} {
  815.     cleanup
  816.     createfile tf1
  817.     createfile tf2
  818.     file mkdir td1
  819.     testchmod 444 tf2
  820.     file rename tf1 [file join td1 tf3]
  821.     file rename tf2 [file join td1 tf4]
  822.     list [catch {glob tf*}] [lsort [glob -directory td1 t*]] 
  823.     [file writable [file join td1 tf3]] [file writable [file join td1 tf4]]
  824. } [subst {1 {[file join td1 tf3] [file join td1 tf4]} 1 0}]
  825. test fCmd-9.11 {file rename: comprehensive: dir to new name and dir} {notRoot testchmod} {
  826.     cleanup
  827.     file mkdir td1
  828.     file mkdir td2
  829.     file mkdir td3
  830.     if {$tcl_platform(platform) != "unix" && $tcl_platform(platform) != "macintosh"} {
  831. testchmod 555 td2
  832.     }
  833.     file rename td1 [file join td3 td3]
  834.     file rename td2 [file join td3 td4]
  835.     if {$tcl_platform(platform) != "unix" && $tcl_platform(platform) != "macintosh"} {
  836. set w4 [file writable [file join td3 td4]]
  837.     } else {
  838.         set w4 0
  839.     }
  840.     list [lsort [glob td*]] [lsort [glob -directory td3 t*]] 
  841.     [file writable [file join td3 td3]] $w4
  842. } [subst {td3 {[file join td3 td3] [file join td3 td4]} 1 0}]
  843. test fCmd-9.12 {file rename: comprehensive: target exists} {notRoot testchmod notNetworkFilesystem} {
  844.     cleanup
  845.     file mkdir [file join td1 td2] [file join td2 td1]
  846.     if {$tcl_platform(platform) != "macintosh"} {
  847.      testchmod 555 [file join td2 td1]
  848.     }
  849.     file mkdir [file join td3 td4] [file join td4 td3]
  850.     file rename -force td3 td4
  851.     set msg [list [file exists td3] [file exists [file join td4 td3 td4]] 
  852.     [catch {file rename td1 td2} msg] $msg]
  853.     if {$tcl_platform(platform) != "macintosh"} {
  854.      testchmod 755 [file join td2 td1]
  855.     }
  856.     set msg
  857. } [subst {0 1 1 {error renaming "td1" to "[file join td2 td1]": file already exists}}]
  858. test fCmd-9.13 {file rename: comprehensive: can't overwrite target} {notRoot} {
  859.     cleanup
  860.     file mkdir [file join td1 td2] [file join td2 td1 td4]
  861.     list [catch {file rename -force td1 td2} msg] $msg
  862. } [subst {1 {error renaming "td1" to "[file join td2 td1]": file already exists}}]
  863. test fCmd-9.14 {file rename: comprehensive: dir into self} {notRoot} {
  864.     cleanup
  865.     file mkdir td1
  866.     list [glob td*] [list [catch {file rename td1 td1} msg] $msg]
  867. } [subst {td1 {1 {error renaming "td1" to "[file join td1 td1]": trying to rename a volume or move a directory into itself}}}]
  868. test fCmd-9.15 {file rename: comprehensive: source and target incompatible} 
  869. {notRoot} {
  870.     cleanup
  871.     file mkdir td1
  872.     createfile tf1
  873.     list [catch {file rename -force td1 tf1} msg] $msg
  874. } {1 {can't overwrite file "tf1" with directory "td1"}}
  875. test fCmd-9.16 {file rename: comprehensive: source and target incompatible} 
  876. {notRoot} {
  877.     cleanup
  878.     file mkdir td1/tf1
  879.     createfile tf1
  880.     list [catch {file rename -force tf1 td1} msg] $msg
  881. } [subst {1 {can't overwrite directory "[file join td1 tf1]" with file "tf1"}}]
  883. test fCmd-10.1 {file copy: comprehensive: source doesn't exist} {notRoot} {
  884.     cleanup
  885.     list [catch {file copy tf1 tf2} msg] $msg
  886. } {1 {error copying "tf1": no such file or directory}}
  887. test fCmd-10.2 {file copy: comprehensive: file to new name} {notRoot testchmod} {
  888.     cleanup
  889.     createfile tf1 tf1
  890.     createfile tf2 tf2
  891.     testchmod 444 tf2
  892.     file copy tf1 tf3
  893.     file copy tf2 tf4
  894.     list [lsort [glob tf*]] [contents tf3] [contents tf4] [file writable tf3] [file writable tf4]
  895. } {{tf1 tf2 tf3 tf4} tf1 tf2 1 0}
  896. test fCmd-10.3 {file copy: comprehensive: dir to new name} {notRoot unixOrPc 95or98 testchmod} {
  897.     cleanup
  898.     file mkdir [file join td1 tdx]
  899.     file mkdir [file join td2 tdy]
  900.     testchmod 555 td2
  901.     file copy td1 td3
  902.     file copy td2 td4
  903.     set msg [list [lsort [glob td*]] [glob -directory td3 t*] 
  904.     [glob -directory td4 t*] [file writable td3] [file writable td4]]
  905.     if {$tcl_platform(platform) != "macintosh"} {
  906.      testchmod 755 td2
  907.      testchmod 755 td4
  908.     }
  909.     set msg
  910. } [subst {{td1 td2 td3 td4} [file join td3 tdx] [file join td4 tdy] 1 0}]
  911. test fCmd-10.3.1 {file copy: comprehensive: dir to new name} {notRoot pc 2000orNewer testchmod} {
  912.     # On Windows with ACLs, copying a directory is defined like this
  913.     cleanup
  914.     file mkdir [file join td1 tdx]
  915.     file mkdir [file join td2 tdy]
  916.     testchmod 555 td2
  917.     file copy td1 td3
  918.     file copy td2 td4
  919.     set msg [list [lsort [glob td*]] [glob -directory td3 t*] 
  920.     [glob -directory td4 t*] [file writable td3] [file writable td4]]
  921.     testchmod 755 td2
  922.     testchmod 755 td4
  923.     set msg
  924. } [subst {{td1 td2 td3 td4} [file join td3 tdx] [file join td4 tdy] 1 1}]
  925. test fCmd-10.4 {file copy: comprehensive: file to existing file} {notRoot testchmod} {
  926.     cleanup
  927.     createfile tf1
  928.     createfile tf2
  929.     createfile tfs1
  930.     createfile tfs2
  931.     createfile tfs3
  932.     createfile tfs4
  933.     createfile tfd1
  934.     createfile tfd2
  935.     createfile tfd3
  936.     createfile tfd4
  937.     testchmod 444 tfs3
  938.     testchmod 444 tfs4
  939.     testchmod 444 tfd2
  940.     testchmod 444 tfd4
  941.     set msg [list [catch {file copy tf1 tf2} msg] $msg]
  942.     file copy -force tfs1 tfd1
  943.     file copy -force tfs2 tfd2
  944.     file copy -force tfs3 tfd3
  945.     file copy -force tfs4 tfd4
  946.     list [lsort [glob tf*]] $msg [file writable tfd1] [file writable tfd2] [file writable tfd3] [file writable tfd4] 
  947. } {{tf1 tf2 tfd1 tfd2 tfd3 tfd4 tfs1 tfs2 tfs3 tfs4} {1 {error copying "tf1" to "tf2": file already exists}} 1 1 0 0}
  948. test fCmd-10.5 {file copy: comprehensive: dir to empty dir} {notRoot testchmod} {
  949.     cleanup
  950.     file mkdir td1
  951.     file mkdir [file join td2 td1]
  952.     file mkdir tds1
  953.     file mkdir tds2
  954.     file mkdir tds3
  955.     file mkdir tds4
  956.     file mkdir [file join tdd1 tds1]
  957.     file mkdir [file join tdd2 tds2]
  958.     file mkdir [file join tdd3 tds3]
  959.     file mkdir [file join tdd4 tds4]
  960.     if {$tcl_platform(platform) != "macintosh"} {
  961. testchmod 555 tds3
  962. testchmod 555 tds4
  963. testchmod 555 [file join tdd2 tds2]
  964. testchmod 555 [file join tdd4 tds4]
  965.     }
  966.     set a1 [list [catch {file copy td1 td2} msg] $msg]
  967.     set a2 [list [catch {file copy -force tds1 tdd1} msg] $msg]
  968.     set a3 [catch {file copy -force tds2 tdd2}]
  969.     set a4 [catch {file copy -force tds3 tdd3}]
  970.     set a5 [catch {file copy -force tds4 tdd4}]
  971.     list [lsort [glob td*]] $a1 $a2 $a3 $a4 $a5 
  972. } [subst {{td1 td2 tdd1 tdd2 tdd3 tdd4 tds1 tds2 tds3 tds4} {1 {error copying "td1" to "[file join td2 td1]": file already exists}} {1 {error copying "tds1" to "[file join tdd1 tds1]": file already exists}} 1 1 1}]
  973. test fCmd-10.6 {file copy: comprehensive: dir to non-empty dir} 
  974. {notRoot unixOrPc testchmod} {
  975.     cleanup
  976.     file mkdir tds1
  977.     file mkdir tds2
  978.     file mkdir [file join tdd1 tds1 xxx]
  979.     file mkdir [file join tdd2 tds2 xxx]
  980.     testchmod 555 tds2
  981.     set a1 [list [catch {file copy -force tds1 tdd1} msg] $msg]
  982.     set a2 [list [catch {file copy -force tds2 tdd2} msg] $msg]
  983.     list [lsort [glob td*]] $a1 $a2 [file writable tds1] [file writable tds2]
  984. } [subst {{tdd1 tdd2 tds1 tds2} {1 {error copying "tds1" to "[file join tdd1 tds1]": file already exists}} {1 {error copying "tds2" to "[file join tdd2 tds2]": file already exists}} 1 0}]
  985. test fCmd-10.7 {file rename: comprehensive: file to new name and dir} {notRoot testchmod} {
  986.     cleanup
  987.     createfile tf1
  988.     createfile tf2
  989.     file mkdir td1
  990.     testchmod 444 tf2
  991.     file copy tf1 [file join td1 tf3]
  992.     file copy tf2 [file join td1 tf4]
  993.     list [lsort [glob tf*]] [lsort [glob -directory td1 t*]] 
  994.     [file writable [file join td1 tf3]] [file writable [file join td1 tf4]]
  995. } [subst {{tf1 tf2} {[file join td1 tf3] [file join td1 tf4]} 1 0}]
  996. test fCmd-10.8 {file rename: comprehensive: dir to new name and dir} 
  997. {notRoot unixOrPc 95or98 testchmod} {
  998.     cleanup
  999.     file mkdir td1
  1000.     file mkdir td2
  1001.     file mkdir td3
  1002.     testchmod 555 td2
  1003.     file copy td1 [file join td3 td3]
  1004.     file copy td2 [file join td3 td4]
  1005.     list [lsort [glob td*]] [lsort [glob -directory td3 t*]] 
  1006.     [file writable [file join td3 td3]] [file writable [file join td3 td4]]
  1007. } [subst {{td1 td2 td3} {[file join td3 td3] [file join td3 td4]} 1 0}]
  1008. test fCmd-10.8.1 {file rename: comprehensive: dir to new name and dir} 
  1009. {notRoot pc 2000orNewer testchmod} {
  1010.     # On Windows with ACLs, copying a directory is defined like this
  1011.     cleanup
  1012.     file mkdir td1
  1013.     file mkdir td2
  1014.     file mkdir td3
  1015.     testchmod 555 td2
  1016.     file copy td1 [file join td3 td3]
  1017.     file copy td2 [file join td3 td4]
  1018.     list [lsort [glob td*]] [lsort [glob -directory td3 t*]] 
  1019.     [file writable [file join td3 td3]] [file writable [file join td3 td4]]
  1020. } [subst {{td1 td2 td3} {[file join td3 td3] [file join td3 td4]} 1 1}]
  1021. test fCmd-10.9 {file copy: comprehensive: source and target incompatible} 
  1022. {notRoot} {
  1023.     cleanup
  1024.     file mkdir td1
  1025.     createfile tf1
  1026.     list [catch {file copy -force td1 tf1} msg] $msg
  1027. } {1 {can't overwrite file "tf1" with directory "td1"}}
  1028. test fCmd-10.10 {file copy: comprehensive: source and target incompatible} 
  1029. {notRoot} {
  1030.     cleanup
  1031.     file mkdir [file join td1 tf1]
  1032.     createfile tf1
  1033.     list [catch {file copy -force tf1 td1} msg] $msg
  1034. } [subst {1 {can't overwrite directory "[file join td1 tf1]" with file "tf1"}}]
  1035. test fCmd-10.11 {file copy: copy to empty file name} {
  1036.     cleanup
  1037.     createfile tf1
  1038.     list [catch {file copy tf1 ""} msg] $msg
  1039. } {1 {error copying "tf1" to "": no such file or directory}}
  1040. test fCmd-10.12 {file rename: rename to empty file name} {
  1041.     cleanup
  1042.     createfile tf1
  1043.     list [catch {file rename tf1 ""} msg] $msg
  1044. } {1 {error renaming "tf1" to "": no such file or directory}}
  1045. cleanup    
  1047. # old tests    
  1049. test fCmd-11.1 {TclFileRenameCmd: -- option } {notRoot} {
  1050.     catch {file delete -force -- -tfa1}
  1051.     set s [createfile -tfa1]
  1052.     file rename -- -tfa1 tfa2
  1053.     set result [expr [checkcontent tfa2 $s] && ![file exists -tfa1]]
  1054.     file delete tfa2
  1055.     set result
  1056. } {1}
  1058. test fCmd-11.2 {TclFileRenameCmd: bad option } {notRoot} {
  1059.     catch {file delete -force -- tfa1}
  1060.     set s [createfile tfa1]
  1061.     set r1 [catch {file rename -x tfa1 tfa2}]
  1062.     set result [expr $r1 && [checkcontent tfa1 $s] && ![file exists tfa2]]
  1063.     file delete tfa1
  1064.     set result
  1065. } {1}
  1067. test fCmd-11.3 {TclFileRenameCmd: bad # args} {
  1068.     catch {file rename -- }
  1069. } {1}
  1071. test fCmd-11.4 {TclFileRenameCmd: target filename translation failing} {notRoot} {
  1072.      global env
  1073.      set temp $env(HOME)
  1074.      unset env(HOME)
  1075.      set result [catch {file rename tfa ~/foobar }]
  1076.      set env(HOME) $temp
  1077.      set result
  1078.  } {1}
  1080. test fCmd-11.5 {TclFileRenameCmd: > 1 source & target is not a dir} {notRoot} {
  1081.     catch {file delete -force -- tfa1 tfa2 tfa3}
  1082.     createfile tfa1 
  1083.     createfile tfa2 
  1084.     createfile tfa3 
  1085.     set result [catch {file rename tfa1 tfa2 tfa3}]
  1086.     file delete tfa1 tfa2 tfa3
  1087.     set result
  1088. } {1}
  1090. test fCmd-11.6 {TclFileRenameCmd: : single file into directory} {notRoot} {
  1091.     catch {file delete -force -- tfa1 tfad}
  1092.     set s [createfile tfa1]
  1093.     file mkdir tfad
  1094.     file rename tfa1 tfad
  1095.     set result [expr [checkcontent tfad/tfa1 $s] && ![file exists tfa1]]
  1096.     file delete -force tfad
  1097.     set result
  1098. } {1}
  1100. test fCmd-11.7 {TclFileRenameCmd: : multiple files into directory} {notRoot} {
  1101.     catch {file delete -force -- tfa1 tfa2 tfad}
  1102.     set s1 [createfile tfa1 ]
  1103.     set s2 [createfile tfa2 ]
  1104.     file mkdir tfad
  1105.     file rename tfa1 tfa2 tfad
  1106.     set r1 [checkcontent tfad/tfa1 $s1]
  1107.     set r2 [checkcontent tfad/tfa2 $s2]
  1108.     
  1109.     set result [expr $r1 && $r2 && ![file exists tfa1] && ![file exists tfa2]]
  1110.     
  1111.     file delete -force tfad
  1112.     set result
  1113. } {1}
  1115. test fCmd-11.8 {TclFileRenameCmd: error renaming file to directory} {notRoot} {
  1116.     catch {file delete -force -- tfa tfad}
  1117.     set s [createfile tfa ]
  1118.     file mkdir tfad
  1119.     file mkdir tfad/tfa
  1120.     set r1 [catch {file rename tfa tfad}]
  1121.     set r2 [checkcontent tfa $s]
  1122.     set r3 [file isdir tfad]
  1123.     set result [expr $r1 && $r2 && $r3 ]
  1124.     file delete -force tfa tfad
  1125.     set result
  1126. } {1}
  1128. #
  1129. # Coverage tests for renamefile() ;
  1130. #
  1131. test fCmd-12.1 {renamefile: source filename translation failing} {notRoot} {
  1132.     global env
  1133.     set temp $env(HOME)
  1134.     unset env(HOME)
  1135.     set result [catch {file rename ~/tfa1 tfa2}]
  1136.     set env(HOME) $temp
  1137.     set result
  1138. } {1}
  1140. test fCmd-12.2 {renamefile: src filename translation failing} {notRoot} {
  1141.     global env
  1142.     set temp $env(HOME)
  1143.     unset env(HOME)
  1144.     set s [createfile tfa1]
  1145.     file mkdir tfad
  1146.     set result [catch {file rename tfa1 ~/tfa2 tfad}]
  1147.     set env(HOME) $temp
  1148.     file delete -force tfad
  1149.     set result
  1150. } {1}
  1152. test fCmd-12.3 {renamefile: stat failing on source} {notRoot} {
  1153.     catch {file delete -force -- tfa1 tfa2}
  1154.     set r1 [catch {file rename tfa1 tfa2}]
  1155.     expr {$r1 && ![file exists tfa1] && ![file exists tfa2]}
  1156. } {1}
  1158. test fCmd-12.4 {renamefile: error renaming file to directory} {notRoot} {
  1159.     catch {file delete -force -- tfa tfad}
  1160.     set s1 [createfile tfa ]
  1161.     file mkdir tfad
  1162.     file mkdir tfad/tfa
  1163.     set r1 [catch {file rename tfa tfad}]
  1164.     set r2 [checkcontent tfa $s1]
  1165.     set r3 [file isdir tfad/tfa]
  1166.     set result [expr $r1 && $r2 && $r3]
  1167.     file delete -force tfa tfad
  1168.     set result
  1169. } {1}
  1171. test fCmd-12.5 {renamefile: error renaming directory to file} {notRoot} {
  1172.     catch {file delete -force -- tfa tfad}
  1173.     file mkdir tfa
  1174.     file mkdir tfad
  1175.     set s [createfile tfad/tfa]
  1176.     set r1 [catch {file rename tfa tfad}]
  1177.     set r2 [checkcontent tfad/tfa $s]
  1178.     set r3 [file isdir tfad]
  1179.     set r4 [file isdir tfa]
  1180.     set result [expr $r1 && $r2 && $r3 && $r4 ]
  1181.     file delete -force tfa tfad
  1182.     set result
  1183. } {1}
  1185. test fCmd-12.6 {renamefile: TclRenameFile succeeding} {notRoot} {
  1186.     catch {file delete -force -- tfa1 tfa2}
  1187.     set s [createfile tfa1]
  1188.     file rename tfa1 tfa2
  1189.     set result [expr [checkcontent tfa2 $s] && ![file exists tfa1]]
  1190.     file delete tfa2
  1191.     set result
  1192. } {1}
  1194. test fCmd-12.7 {renamefile: renaming directory into offspring} {notRoot} {
  1195.     catch {file delete -force -- tfad}
  1196.     file mkdir tfad
  1197.     file mkdir tfad/dir
  1198.     set result [catch {file rename tfad tfad/dir}]
  1199.     file delete -force tfad 
  1200.     set result
  1201. } {1}
  1203. test fCmd-12.8 {renamefile: generic error} {unixOnly notRoot} {
  1204.     catch {file delete -force -- tfa}
  1205.     file mkdir tfa
  1206.     file mkdir tfa/dir
  1207.     file attributes tfa -permissions 0555
  1208.     set result [catch {file rename tfa/dir tfa2}]
  1209.     file attributes tfa -permissions 0777
  1210.     file delete -force tfa
  1211.     set result
  1212. } {1}
  1215. test fCmd-12.9 {renamefile: moving a file across volumes} {unixOnly notRoot} {
  1216.     catch {file delete -force -- tfa /tmp/tfa}
  1217.     set s [createfile tfa ]
  1218.     file rename tfa /tmp
  1219.     set result [expr [checkcontent /tmp/tfa $s] && ![file exists tfa]]
  1220.     file delete /tmp/tfa
  1221.     set result
  1222. } {1}
  1224. test fCmd-12.10 {renamefile: moving a directory across volumes } 
  1225. {unixOnly notRoot} {
  1226.     catch {file delete -force -- tfad /tmp/tfad}
  1227.     file mkdir tfad
  1228.     set s [createfile tfad/a ]
  1229.     file rename tfad /tmp
  1230.     set restul [expr [checkcontent /tmp/tfad/a $s] && ![file exists tfad]]
  1231.     file delete -force /tmp/tfad
  1232.     set result
  1233. } {1}
  1235. #
  1236. # Coverage tests for TclCopyFilesCmd()
  1237. #
  1238. test fCmd-13.1 {TclCopyFilesCmd: -force option} {notRoot} {
  1239.     catch {file delete -force -- tfa1}
  1240.     set s [createfile tfa1]
  1241.     file copy -force  tfa1 tfa2
  1242.     set result [expr [checkcontent tfa2 $s] && [checkcontent tfa1 $s]]
  1243.     file delete tfa1 tfa2
  1244.     set result
  1245. } {1}
  1247. test fCmd-13.2 {TclCopyFilesCmd: -- option} {notRoot} {
  1248.     catch {file delete -force -- tfa1}
  1249.     set s [createfile -tfa1]
  1250.     file copy --  -tfa1 tfa2
  1251.     set result [expr [checkcontent tfa2 $s] &&  [checkcontent -tfa1 $s]]
  1252.     file delete -- -tfa1 tfa2
  1253.     set result
  1254. } {1}
  1256. test fCmd-13.3 {TclCopyFilesCmd: bad option} {notRoot} {
  1257.     catch {file delete -force -- tfa1}
  1258.     set s [createfile tfa1]
  1259.     set r1 [catch {file copy -x tfa1 tfa2}]
  1260.     set result [expr $r1 && [checkcontent tfa1 $s] && ![file exists tfa2]]
  1261.     file delete tfa1
  1262.     set result
  1263. } {1}
  1265. test fCmd-13.4 {TclCopyFilesCmd: bad # args} {notRoot} {
  1266.     catch {file copy -- }
  1267. } {1}
  1269. test fCmd-13.5 {TclCopyFilesCmd: target filename translation failing} {
  1270.      global env
  1271.      set temp $env(HOME)
  1272.     unset env(HOME)
  1273.      set result [catch {file copy tfa ~/foobar }]
  1274.      set env(HOME) $temp
  1275.      set result
  1276.  } {1}
  1278. test fCmd-13.6 {TclCopyFilesCmd: > 1 source & target is not a dir} {notRoot} {
  1279.     catch {file delete -force -- tfa1 tfa2 tfa3}
  1280.     createfile tfa1 
  1281.     createfile tfa2 
  1282.     createfile tfa3 
  1283.     set result [catch {file copy tfa1 tfa2 tfa3}]
  1284.     file delete tfa1 tfa2 tfa3
  1285.     set result
  1286. } {1}
  1288. test fCmd-13.7 {TclCopyFilesCmd: single file into directory} {notRoot} {
  1289.     catch {file delete -force -- tfa1 tfad}
  1290.     set s [createfile tfa1]
  1291.     file mkdir tfad
  1292.     file copy tfa1 tfad
  1293.     set result [expr [checkcontent tfad/tfa1 $s] &&  [checkcontent tfa1 $s]]
  1294.     file delete -force tfad tfa1
  1295.     set result
  1296. } {1}
  1298. test fCmd-13.8 {TclCopyFilesCmd: multiple files into directory} {notRoot} {
  1299.     catch {file delete -force -- tfa1 tfa2 tfad}
  1300.     set s1 [createfile tfa1 ]
  1301.     set s2 [createfile tfa2 ]
  1302.     file mkdir tfad
  1303.     file copy tfa1 tfa2 tfad
  1304.     set r1 [checkcontent tfad/tfa1 $s1]
  1305.     set r2 [checkcontent tfad/tfa2 $s2]
  1306.     set r3 [checkcontent tfa1 $s1]
  1307.     set r4 [checkcontent tfa2 $s2]
  1308.     set result [expr $r1 && $r2 && $r3 && $r4 ]
  1309.     
  1310.     file delete -force tfad tfa1 tfa2
  1311.     set result
  1312. } {1}
  1314. test fCmd-13.9 {TclCopyFilesCmd: error copying file to directory} {notRoot} {
  1315.     catch {file delete -force -- tfa tfad}
  1316.     set s [createfile tfa ]
  1317.     file mkdir tfad
  1318.     file mkdir tfad/tfa
  1319.     set r1 [catch {file copy tfa tfad}]
  1320.     set r2 [expr [checkcontent tfa $s] && [file isdir tfad/tfa]]
  1321.     set r3 [file isdir tfad]
  1322.     set result [expr $r1 && $r2 && $r3 ]
  1323.     file delete -force tfa tfad
  1324.     set result
  1325. } {1}
  1327. #
  1328. # Coverage tests for copyfile()
  1329. # 
  1330. test fCmd-14.1 {copyfile: source filename translation failing} {notRoot} {
  1331.     global env
  1332.     set temp $env(HOME)
  1333.     unset env(HOME)
  1334.     set result [catch {file copy ~/tfa1 tfa2}]
  1335.     set env(HOME) $temp
  1336.     set result
  1337. } {1}
  1339. test fCmd-14.2 {copyfile: dst filename translation failing} {notRoot} {
  1340.     global env
  1341.     set temp $env(HOME)
  1342.     unset env(HOME)
  1343.     set s [createfile tfa1]
  1344.     file mkdir tfad
  1345.     set r1 [catch {file copy tfa1 ~/tfa2 tfad}]
  1346.     set result [expr $r1 && [checkcontent tfad/tfa1 $s]]
  1347.     set env(HOME) $temp
  1348.     file delete -force tfa1 tfad
  1349.     set result
  1350. } {1}
  1352. test fCmd-14.3 {copyfile: stat failing on source} {notRoot} {
  1353.     catch {file delete -force -- tfa1 tfa2}
  1354.     set r1 [catch {file copy tfa1 tfa2}]
  1355.     expr $r1 && ![file exists tfa1] && ![file exists tfa2]
  1356. } {1}
  1358. test fCmd-14.4 {copyfile: error copying file to directory} {notRoot} {
  1359.     catch {file delete -force -- tfa tfad}
  1360.     set s1 [createfile tfa ]
  1361.     file mkdir tfad
  1362.     file mkdir tfad/tfa
  1363.     set r1 [catch {file copy tfa tfad}]
  1364.     set r2 [checkcontent tfa $s1]
  1365.     set r3 [file isdir tfad]
  1366.     set r4 [file isdir tfad/tfa]
  1367.     set result [expr $r1 && $r2 && $r3 && $r4 ]
  1368.     file delete -force tfa tfad
  1369.     set result
  1370. } {1}
  1372.  test fCmd-14.5 {copyfile: error copying directory to file} {notRoot} {
  1373.      catch {file delete -force -- tfa tfad}
  1374.      file mkdir tfa
  1375.      file mkdir tfad
  1376.      set s [createfile tfad/tfa]
  1377.      set r1 [catch {file copy tfa tfad}]
  1378.      set r2 [checkcontent tfad/tfa $s]
  1379.      set r3 [file isdir tfad]
  1380.      set r4 [file isdir tfa]
  1381.      set result [expr $r1 && $r2 && $r3 && $r4 ]
  1382.      file delete -force tfa tfad
  1383.      set result
  1384. } {1}
  1386. test fCmd-14.6 {copyfile: copy file succeeding} {notRoot} {
  1387.     catch {file delete -force -- tfa tfa2}
  1388.     set s [createfile tfa]
  1389.     file copy tfa tfa2
  1390.     set result [expr  [checkcontent tfa $s] && [checkcontent tfa2 $s]]
  1391.     file delete tfa tfa2
  1392.     set result
  1393. } {1}
  1395. test fCmd-14.7 {copyfile: copy directory succeeding} {notRoot} {
  1396.     catch {file delete -force -- tfa tfa2}
  1397.     file mkdir tfa
  1398.     set s [createfile tfa/file]
  1399.     file copy tfa tfa2
  1400.     set result [expr [checkcontent tfa/file $s] && [checkcontent tfa2/file $s]]
  1401.     file delete -force tfa tfa2
  1402.     set result
  1403. } {1}
  1405. test fCmd-14.8 {copyfile: copy directory failing} {unixOnly notRoot} {
  1406.     catch {file delete -force -- tfa}
  1407.     file mkdir tfa/dir/a/b/c
  1408.     file attributes tfa/dir -permissions 0000
  1409.     set r1 [catch {file copy tfa tfa2}]
  1410.     file attributes tfa/dir -permissions 0777
  1411.     set result $r1
  1412.     file delete -force tfa tfa2
  1413.     set result
  1414. } {1}
  1416. #
  1417. # Coverage tests for TclMkdirCmd()
  1418. #
  1419. test fCmd-15.1 {TclMakeDirsCmd: target filename translation failing} {notRoot} {
  1420.     global env
  1421.     set temp $env(HOME)
  1422.     unset env(HOME) 
  1423.     set result [catch {file mkdir ~/tfa}]
  1424.     set env(HOME) $temp
  1425.     set result
  1426. } {1}
  1427. #
  1428. # Can Tcl_SplitPath return argc == 0? If so them we need a
  1429. # test for that code.
  1430. #
  1431. test fCmd-15.2 {TclMakeDirsCmd - one directory } {notRoot} {
  1432.     catch {file delete -force -- tfa}
  1433.     file mkdir tfa
  1434.     set result [file isdirectory tfa]
  1435.     file delete tfa
  1436.     set result
  1437. } {1}
  1439. test fCmd-15.3 {TclMakeDirsCmd: - two directories} {notRoot} {
  1440.     catch {file delete -force -- tfa1 tfa2}
  1441.     file mkdir tfa1 tfa2
  1442.     set result [expr [file isdirectory tfa1] && [file isdirectory tfa2]]
  1443.     file delete tfa1 tfa2
  1444.     set result
  1445. } {1}
  1447. test fCmd-15.4 {TclMakeDirsCmd - stat failing} {unixOnly notRoot} {
  1448.     catch {file delete -force -- tfa}
  1449.     file mkdir tfa
  1450.     createfile tfa/file
  1451.     file attributes tfa -permissions 0000
  1452.     set result [catch {file mkdir tfa/file}]
  1453.     file attributes tfa -permissions 0777
  1454.     file delete -force tfa
  1455.     set result
  1456. } {1}
  1458. test fCmd-15.5 {TclMakeDirsCmd: - making a directory several levels deep} 
  1459. {notRoot} {
  1460.     catch {file delete -force -- tfa}
  1461.     file mkdir tfa/a/b/c
  1462.     set result [file isdir tfa/a/b/c]
  1463.     file delete -force tfa
  1464.     set result
  1465. } {1}
  1467.     
  1468. test fCmd-15.6 {TclMakeDirsCmd: - trying to overwrite a file} {notRoot} {
  1469.     catch {file delete -force -- tfa}
  1470.     set s [createfile tfa]
  1471.     set r1 [catch {file mkdir tfa}]
  1472.     set r2 [file isdir tfa]
  1473.     set r3 [file exists tfa]
  1474.     set result [expr $r1 && !$r2 && $r3 && [checkcontent tfa $s]]
  1475.     file delete tfa
  1476.     set result
  1477. } {1}
  1479. test fCmd-15.7 {TclMakeDirsCmd - making several directories} {notRoot} {
  1480.     catch {file delete -force -- tfa1 tfa2}
  1481.     file mkdir tfa1 tfa2/a/b/c
  1482.     set result [expr [file isdir tfa1] && [file isdir tfa2/a/b/c]]
  1483.     file delete -force tfa1 tfa2
  1484.     set result
  1485. } {1}
  1487. test fCmd-15.8 {TclFileMakeDirsCmd: trying to create an existing dir} {notRoot} {
  1488.     file mkdir tfa
  1489.     file mkdir tfa
  1490.     set result [file isdir tfa]
  1491.     file delete tfa
  1492.     set result
  1493. } {1}
  1496. # Coverage tests for TclDeleteFilesCommand()
  1497. test fCmd-16.1 {test the -- argument} {notRoot} {
  1498.     catch {file delete -force -- tfa}
  1499.     createfile tfa
  1500.     file delete -- tfa
  1501.     file exists tfa
  1502. } {0}
  1504. test fCmd-16.2 {test the -force and -- arguments} {notRoot} {
  1505.     catch {file delete -force -- tfa}
  1506.     createfile tfa
  1507.     file delete -force -- tfa
  1508.     file exists tfa
  1509. } {0}
  1511. test fCmd-16.3 {test bad option} {notRoot} {
  1512.     catch {file delete -force -- tfa}
  1513.     createfile tfa
  1514.     set result [catch {file delete -dog tfa}]
  1515.     file delete tfa
  1516.     set result
  1517. } {1}
  1519. test fCmd-16.4 {test not enough args} {notRoot} {
  1520.     catch {file delete}
  1521. } {1}
  1523. test fCmd-16.5 {test not enough args with options} {notRoot} {
  1524.     catch {file delete --}
  1525. } {1}
  1527. test fCmd-16.6 {delete: source filename translation failing} {notRoot} {
  1528.     global env
  1529.     set temp $env(HOME)
  1530.     unset env(HOME)
  1531.     set result [catch {file delete ~/tfa}]
  1532.     set env(HOME) $temp
  1533.     set result
  1534. } {1}
  1536. test fCmd-16.7 {remove a non-empty directory without -force } {notRoot} {
  1537.     catch {file delete -force -- tfa}
  1538.     file mkdir tfa
  1539.     createfile tfa/a
  1540.     set result [catch  {file delete tfa }]
  1541.     file delete -force tfa
  1542.     set result
  1543. } {1}
  1545. test fCmd-16.8 {remove a normal file } {notRoot} {
  1546.     catch {file delete -force -- tfa}
  1547.     file mkdir tfa
  1548.     createfile tfa/a
  1549.     set result [catch  {file delete tfa }]
  1550.     file delete -force tfa
  1551.     set result
  1552. } {1}
  1554. test fCmd-16.9 {error while deleting file } {unixOnly notRoot} {
  1555.     catch {file delete -force -- tfa}
  1556.     file mkdir tfa
  1557.     createfile tfa/a
  1558.     file attributes tfa -permissions 0555
  1559.     set result [catch  {file delete tfa/a }]
  1560.     #######
  1561.     #######  If any directory in a tree that is being removed does not 
  1562.     #######  have write permission, the process will fail!
  1563.     #######  This is also the case with "rm -rf"
  1564.     #######
  1565.     file attributes tfa -permissions 0777
  1566.     file delete -force tfa
  1567.     set result
  1568. } {1}
  1570. test fCmd-16.10 {deleting multiple files} {notRoot} {
  1571.     catch {file delete -force -- tfa1 tfa2}
  1572.     createfile tfa1
  1573.     createfile tfa2
  1574.     file delete tfa1 tfa2
  1575.     expr ![file exists tfa1] && ![file exists tfa2]
  1576. } {1}
  1578. test fCmd-16.11 {TclFileDeleteCmd: removing a nonexistant file} {notRoot} {
  1579.     catch {file delete -force -- tfa}
  1580.     file delete tfa
  1581.     set result 1
  1582. } {1}
  1584. # More coverage tests for mkpath()
  1585.  test fCmd-17.1 {mkdir stat failing on target but not ENOENT} {unixOnly notRoot} {
  1586.      catch {file delete -force -- tfa1}
  1587.      file mkdir tfa1
  1588.      file attributes tfa1 -permissions 0555
  1589.      set result [catch {file mkdir tfa1/tfa2}]
  1590.      file attributes tfa1 -permissions 0777
  1591.      file delete -force tfa1
  1592.      set result
  1593. } {1}
  1595. test fCmd-17.2 {mkdir several levels deep - relative } {notRoot} {
  1596.     catch {file delete -force -- tfa}
  1597.     file mkdir tfa/a/b
  1598.     set result [file isdir tfa/a/b ]
  1599.     file delete tfa/a/b tfa/a tfa
  1600.     set result
  1601. } {1}
  1603. test fCmd-17.3 {mkdir several levels deep - absolute } {notRoot} {
  1604.     catch {file delete -force -- tfa}
  1605.     set f [file join [pwd] tfa a ]
  1606.     file mkdir $f
  1607.     set result [file isdir $f ]
  1608.     file delete $f [file join [pwd] tfa]
  1609.     set result
  1610. } {1}
  1612. #
  1613. # Functionality tests for TclFileRenameCmd()
  1614. #
  1616. test fCmd-18.1 {TclFileRenameCmd: rename (first form) in the same directory} 
  1617. {notRoot} {
  1618.     catch {file delete -force -- tfad}
  1619.     file mkdir tfad/dir
  1620.     cd tfad/dir
  1621.     set s [createfile foo ]
  1622.     file rename  foo bar
  1623.     file rename bar ./foo
  1624.     file rename ./foo bar
  1625.     file rename ./bar ./foo
  1626.     file rename foo ../dir/bar
  1627.     file rename ../dir/bar ./foo
  1628.     file rename ../../tfad/dir/foo ../../tfad/dir/bar
  1629.     file rename [file join [pwd] bar] foo
  1630.     file rename foo [file join [pwd] bar]
  1631.     set result [expr [checkcontent bar $s] && ![file exists foo]]
  1632.     cd ../..
  1633.     file delete -force tfad
  1634.     set result
  1635. } {1}
  1637. test fCmd-18.2 {TclFileRenameCmd: single dir to nonexistant} {notRoot} {
  1638.     catch {file delete -force -- tfa1 tfa2}
  1639.     file mkdir tfa1
  1640.     file rename tfa1 tfa2
  1641.     set result [expr [file exists tfa2] && ![file exists tfa1]]
  1642.     file delete tfa2
  1643.     set result
  1644. } {1}
  1646. test fCmd-18.3 {TclFileRenameCmd: mixed dirs and files into directory} {notRoot} {
  1647.     catch {file delete -force -- tfa1 tfad1 tfad2}
  1648.     set s [createfile tfa1 ]
  1649.     file mkdir tfad1 tfad2
  1650.     file rename tfa1 tfad1 tfad2
  1651.     set r1 [checkcontent  tfad2/tfa1 $s]
  1652.     set r2 [file isdir tfad2/tfad1]
  1653.     set result [expr $r1 && $r2 && ![file exists tfa1] && ![file exists tfad1]]
  1654.     file delete tfad2/tfa1
  1655.     file delete -force tfad2
  1656.     set result
  1657. } {1}
  1659. test fCmd-18.4 {TclFileRenameCmd: attempt to replace non-dir with dir} {notRoot} {
  1660.     catch {file delete -force -- tfa tfad}
  1661.     set s [createfile tfa ]
  1662.     file mkdir tfad
  1663.     set r1 [catch {file rename tfad tfa}]
  1664.     set r2 [checkcontent tfa $s]
  1665.     set r3 [file isdir tfad]
  1666.     set result [expr $r1 && $r2 && $r3 ]
  1667.     file delete tfa tfad
  1668.     set result
  1669. } {1}
  1671. test fCmd-18.5 {TclFileRenameCmd: attempt to replace dir with non-dir} {notRoot} {
  1672.     catch {file delete -force -- tfa tfad}
  1673.     set s [createfile tfa ]
  1674.     file mkdir tfad/tfa
  1675.     set r1 [catch {file rename tfa tfad}]
  1676.     set r2 [checkcontent tfa $s]
  1677.     set r3 [file isdir tfad/tfa]
  1678.     set result [expr $r1 && $r2 && $r3 ]
  1679.     file delete -force  tfa tfad
  1680.     set result
  1681. } {1}
  1683. #
  1684. # On Windows there is no easy way to determine if two files are the same
  1685. #
  1686. test fCmd-18.6 {TclFileRenameCmd: rename a file to itself} {macOrUnix notRoot} {
  1687.     catch {file delete -force -- tfa}
  1688.     set s [createfile tfa]
  1689.     set r1 [catch {file rename tfa tfa}]
  1690.     set result [expr $r1 && [checkcontent tfa $s]]
  1691.     file delete tfa
  1692.     set result
  1693. } {1}
  1695. test fCmd-18.7 {TclFileRenameCmd: rename dir on top of another empty dir w/o -force} 
  1696. {notRoot} {
  1697.     catch {file delete -force -- tfa tfad}
  1698.     file mkdir tfa tfad/tfa
  1699.     set r1 [catch {file rename tfa tfad}]
  1700.     set result [expr $r1 && [file isdir tfa]]
  1701.     file delete -force tfa tfad
  1702.     set result
  1703. } {1}
  1705. test fCmd-18.8 {TclFileRenameCmd: rename dir on top of another empty dir w/ -force} 
  1706. {notRoot notNetworkFilesystem} {
  1707.     catch {file delete -force -- tfa tfad}
  1708.     file mkdir tfa tfad/tfa
  1709.     file rename -force tfa tfad
  1710.     set result [expr ![file isdir tfa]]
  1711.     file delete -force tfad
  1712.     set result
  1713. } {1}
  1715. test fCmd-18.9 {TclFileRenameCmd: rename dir on top of a non-empty dir w/o -force} 
  1716. {notRoot} {
  1717.     catch {file delete -force -- tfa tfad}
  1718.     file mkdir tfa tfad/tfa/file
  1719.     set r1 [catch {file rename tfa tfad}]
  1720.     set result [expr $r1 && [file isdir tfa] && [file isdir tfad/tfa/file]]
  1721.     file delete -force tfa tfad
  1722.     set result
  1723. } {1}
  1725. test fCmd-18.10 {TclFileRenameCmd: rename dir on top of a non-empty dir w/ -force} 
  1726. {notRoot notNetworkFilesystem} {
  1727.     catch {file delete -force -- tfa tfad}
  1728.     file mkdir tfa tfad/tfa/file
  1729.     set r1 [catch {file rename -force tfa tfad}]
  1730.     set result [expr $r1 && [file isdir tfa] && [file isdir tfad/tfa/file]]
  1731.     file delete -force tfa tfad
  1732.     set result
  1733. } {1}
  1735. test fCmd-18.11 {TclFileRenameCmd: rename a non-existant file} {notRoot} {
  1736.     catch {file delete -force -- tfa1}
  1737.     set r1 [catch {file rename tfa1 tfa2}]
  1738.     set result [expr $r1 && ![file exists tfa1] && ![file exists tfa2]]
  1739. } {1}
  1741. test fCmd-18.12 {TclFileRenameCmd : rename a symbolic link to file} 
  1742. {unixOnly notRoot} {
  1743.     catch {file delete -force -- tfa1 tfa2 tfa3}
  1745.     set s [createfile tfa1]
  1746.     file link -symbolic tfa2 tfa1
  1747.     file rename tfa2 tfa3
  1748.     set t [file type tfa3]
  1749.     set result [expr {$t eq "link"}]
  1750.     file delete tfa1 tfa3
  1751.     set result
  1752. } {1}
  1754. test fCmd-18.13 {TclFileRenameCmd : rename a symbolic link to dir} 
  1755. {unixOnly notRoot} {
  1756.     catch {file delete -force -- tfa1 tfa2 tfa3}
  1758.     file mkdir tfa1
  1759.     file link -symbolic tfa2 tfa1
  1760.     file rename tfa2 tfa3
  1761.     set t [file type tfa3]
  1762.     set result [expr {$t eq "link"}]
  1763.     file delete tfa1 tfa3
  1764.     set result
  1765. } {1}
  1767. test fCmd-18.14 {TclFileRenameCmd : rename a path with sym link} 
  1768. {unixOnly notRoot} {
  1769.     catch {file delete -force -- tfa1 tfa2 tfa3}
  1771.     file mkdir tfa1/a/b/c/d
  1772.     file mkdir tfa2
  1773.     set f [file join [pwd] tfa1/a/b] 
  1774.     set f2 [file join [pwd] {tfa2/b alias}]
  1775.     file link -symbolic $f2 $f
  1776.     file rename {tfa2/b alias/c} tfa3
  1777.     set r1 [file isdir tfa3]
  1778.     set r2 [file exists tfa1/a/b/c]
  1779.     set result [expr $r1 && !$r2]
  1780.     file delete -force tfa1 tfa2 tfa3
  1781.     set result
  1782. } {1}
  1784. test fCmd-18.15 {TclFileRenameCmd : rename a file to a symlink dir} 
  1785. {unixOnly notRoot} {
  1786.     catch {file delete -force -- tfa1 tfa2 tfalink}
  1788.     file mkdir tfa1
  1789.     set s [createfile tfa2]
  1790.     file link -symbolic tfalink tfa1
  1792.     file rename tfa2 tfalink
  1793.     set result [checkcontent tfa1/tfa2 $s ]
  1794.     file delete -force tfa1 tfalink
  1795.     set result
  1796. } {1}
  1798. test fCmd-18.16 {TclFileRenameCmd: rename a dangling symlink} {unixOnly notRoot} {
  1799.     catch {file delete -force -- tfa1 tfalink}
  1801.     file mkdir tfa1
  1802.     file link -symbolic tfalink tfa1
  1803.     file delete tfa1 
  1804.     file rename tfalink tfa2
  1805.     set result [expr [string compare [file type tfa2] "link"] == 0]
  1806.     file delete tfa2
  1807.     set result
  1808. } {1}
  1811. #
  1812. # Coverage tests for TclUnixRmdir
  1813. #
  1814. test fCmd-19.1 {remove empty directory} {notRoot} {
  1815.     catch {file delete -force -- tfa}
  1816.     file mkdir tfa
  1817.     file delete tfa
  1818.     file exists tfa
  1819. } {0}
  1821. test fCmd-19.2 {rmdir error besides EEXIST} {unixOnly notRoot} {
  1822.     catch {file delete -force -- tfa}
  1823.     file mkdir tfa
  1824.     file mkdir tfa/a
  1825.     file attributes tfa -permissions 0555
  1826.     set result [catch {file delete tfa/a}]
  1827.     file attributes tfa -permissions 0777
  1828.     file delete -force tfa
  1829.     set result
  1830. } {1}
  1832. test fCmd-19.3 {recursive remove} {notRoot} {
  1833.     catch {file delete -force -- tfa}
  1834.     file mkdir tfa
  1835.     file mkdir tfa/a
  1836.     file delete -force tfa
  1837.     file exists tfa
  1838. } {0}
  1840. #
  1841. # TclUnixDeleteFile and TraversalDelete are covered by tests from the 
  1842. # TclDeleteFilesCmd suite
  1843. #
  1844. #
  1846. #
  1847. # Coverage tests for TraverseUnixTree(), called from TclDeleteFilesCmd
  1848. #
  1850. test fCmd-20.1 {TraverseUnixTree : failure opening a subdirectory directory } 
  1851. {unixOnly notRoot} {
  1852.     catch {file delete -force -- tfa}
  1853.     file mkdir tfa
  1854.     file mkdir tfa/a
  1855.     file attributes tfa/a -permissions 0000
  1856.     set result [catch {file delete -force tfa}]
  1857.     file attributes tfa/a -permissions 0777
  1858.     file delete -force tfa
  1859.     set result
  1860. } {1}
  1862. test fCmd-20.2 {TraverseUnixTree : recursive delete of large directory: Bug 1034337} 
  1863. {unix notRoot} {
  1864.     catch {file delete -force -- tfa}
  1865.     file mkdir tfa
  1866.     for {set i 1} {$i <= 300} {incr i} {createfile tfa/testfile_$i}
  1867.     set result [catch {file delete -force tfa} msg]
  1868.     while {[catch {file delete -force tfa}]} {}
  1869.     list $result $msg
  1870. } {0 {}}
  1872. #
  1873. # Feature testing for TclCopyFilesCmd
  1874. # 
  1875. test fCmd-21.1 {copy : single file to nonexistant } {notRoot} {
  1876.     catch {file delete -force -- tfa1 tfa2}
  1877.     set s [createfile tfa1]
  1878.     file copy tfa1 tfa2
  1879.     set result [expr [checkcontent tfa2 $s] && [checkcontent tfa1 $s]]
  1880.     file delete tfa1 tfa2
  1881.     set result
  1882. } {1}
  1884. test fCmd-21.2 {copy : single dir to nonexistant } {notRoot} {
  1885.     catch {file delete -force -- tfa1 tfa2}
  1886.     file mkdir tfa1
  1887.     file copy tfa1 tfa2
  1888.     set result [expr [file isdir tfa2] && [file isdir tfa1]]
  1889.     file delete tfa1 tfa2
  1890.     set result
  1891. } {1}
  1893. test fCmd-21.3 {copy : single file into directory  } {notRoot} {
  1894.     catch {file delete -force -- tfa1 tfad}
  1895.     set s [createfile tfa1]
  1896.     file mkdir tfad
  1897.     file copy tfa1 tfad
  1898.     set result [expr [checkcontent tfad/tfa1 $s] && [checkcontent tfa1 $s]]
  1899.     file delete -force tfa1 tfad
  1900.     set result
  1901. } {1}
  1903. test fCmd-21.4 {copy : more than one source and target is not a directory} 
  1904. {notRoot} {
  1905.     catch {file delete -force -- tfa1 tfa2 tfa3}
  1906.     createfile tfa1 
  1907.     createfile tfa2 
  1908.     createfile tfa3 
  1909.     set result [catch {file copy tfa1 tfa2 tfa3}]
  1910.     file delete tfa1 tfa2 tfa3
  1911.     set result
  1912. } {1}
  1914. test fCmd-21.5 {copy : multiple files into directory  } {notRoot} {
  1915.     catch {file delete -force -- tfa1 tfa2 tfad}
  1916.     set s1 [createfile tfa1 ]
  1917.     set s2 [createfile tfa2 ]
  1918.     file mkdir tfad
  1919.     file copy tfa1 tfa2 tfad
  1920.     set r1 [checkcontent tfad/tfa1 $s1]
  1921.     set r2 [checkcontent tfad/tfa2 $s2]
  1922.     set r3 [checkcontent tfa1 $s1]
  1923.     set r4 [checkcontent tfa2 $s2]
  1924.     set result [expr $r1 && $r2 && $r3 && $r4]
  1925.     file delete -force tfa1 tfa2 tfad
  1926.     set result
  1927. } {1}
  1929. test fCmd-21.6 {copy: mixed dirs and files into directory} 
  1930. {notRoot notFileSharing} {
  1931.     catch {file delete -force -- tfa1 tfad1 tfad2}
  1932.     set s [createfile tfa1 ]
  1933.     file mkdir tfad1 tfad2
  1934.     file copy tfa1 tfad1 tfad2
  1935.     set r1 [checkcontent [file join tfad2 tfa1] $s]
  1936.     set r2 [file isdir [file join tfad2 tfad1]]
  1937.     set r3 [checkcontent tfa1 $s]
  1938.     set result [expr $r1 && $r2 && $r3 && [file isdir tfad1]]
  1939.     file delete -force tfa1 tfad1 tfad2
  1940.     set result
  1941. } {1}
  1943. test fCmd-21.7.1 {TclCopyFilesCmd: copy a dangling link} {unixOnly notRoot dontCopyLinks} {
  1944.     file mkdir tfad1
  1945.     file link -symbolic tfalink tfad1
  1946.     file delete tfad1
  1947.     set result [list [catch {file copy tfalink tfalink2} msg] $msg]
  1948.     file delete -force tfalink tfalink2 
  1949.     set result
  1950. } {1 {error copying "tfalink": the target of this link doesn't exist}}
  1951. test fCmd-21.7.2 {TclCopyFilesCmd: copy a dangling link} {unixOnly notRoot} {
  1952.     file mkdir tfad1
  1953.     file link -symbolic tfalink tfad1
  1954.     file delete tfad1
  1955.     file copy tfalink tfalink2
  1956.     set result [string match [file type tfalink2] link]
  1957.     file delete tfalink tfalink2 
  1958.     set result
  1959. } {1}
  1961. test fCmd-21.8.1 {TclCopyFilesCmd: copy a link } {unixOnly notRoot dontCopyLinks} {
  1962.     file mkdir tfad1
  1963.     file link -symbolic tfalink tfad1
  1964.     file copy tfalink tfalink2
  1965.     set r1 [file type tfalink]; # link
  1966.     set r2 [file type tfalink2]; # directory
  1967.     set r3 [file isdir tfad1]; # 1
  1968.     set result [expr {("$r1" == "link") && ("$r2" == "directory") && $r3}]
  1969.     file delete -force tfad1 tfalink tfalink2
  1970.     set result
  1971. } {1}
  1972. test fCmd-21.8.2 {TclCopyFilesCmd: copy a link } {unixOnly notRoot} {
  1973.     file mkdir tfad1
  1974.     file link -symbolic tfalink tfad1
  1975.     file copy tfalink tfalink2
  1976.     set r1 [file type tfalink]; # link
  1977.     set r2 [file type tfalink2]; # link
  1978.     set r3 [file isdir tfad1]; # 1
  1979.     set result [expr {("$r1" == "link") && ("$r2" == "link") && $r3}]
  1980.     file delete -force tfad1 tfalink tfalink2
  1981.     set result
  1982. } {1}
  1984. test fCmd-21.9 {TclCopyFilesCmd: copy dir with a link in it} {unixOnly notRoot} {
  1985.     file mkdir tfad1
  1986.     file link -symbolic tfad1/tfalink "[pwd]/tfad1"
  1987.     file copy tfad1 tfad2
  1988.     set result [string match [file type tfad2/tfalink] link]
  1989.     file delete -force tfad1 tfad2
  1990.     set result
  1991. } {1}
  1993. test fCmd-21.10 {TclFileCopyCmd: copy dir on top of another empty dir w/o -force} 
  1994. {notRoot} {
  1995.     catch {file delete -force -- tfa tfad}
  1996.     file mkdir tfa [file join tfad tfa]
  1997.     set r1 [catch {file copy tfa tfad}]
  1998.     set result [expr $r1 && [file isdir tfa]]
  1999.     file delete -force tfa tfad
  2000.     set result
  2001. } {1}
  2003. test fCmd-21.11 {TclFileCopyCmd: copy dir on top of a dir w/o -force} {notRoot} {
  2004.     catch {file delete -force -- tfa tfad}
  2005.     file mkdir tfa [file join tfad tfa file]
  2006.     set r1 [catch {file copy tfa tfad}]
  2007.     set result [expr $r1 && [file isdir tfa] && [file isdir [file join tfad tfa file]]]
  2008.     file delete -force tfa tfad
  2009.     set result
  2010. } {1}
  2012. test fCmd-21.12 {TclFileCopyCmd: copy dir on top of a non-empty dir w/ -force} 
  2013. {notRoot} {
  2014.     catch {file delete -force -- tfa tfad}
  2015.     file mkdir tfa [file join tfad tfa file]
  2016.     set r1 [catch {file copy -force tfa tfad}]
  2017.     set result [expr $r1 && [file isdir tfa] && [file isdir [file join tfad tfa file]]]
  2018.     file delete -force tfa tfad
  2019.     set result
  2020. } {1}
  2022. #
  2023. # Coverage testing for TclpRenameFile
  2024. #
  2025. test fCmd-22.1 {TclpRenameFile: rename and overwrite in a single dir} {notRoot} {
  2026.     catch {file delete -force -- tfa1 tfa2}
  2027.     set s [createfile tfa1]
  2028.     set s2 [createfile tfa2 q]
  2030.     set r1 [catch {rename tfa1 tfa2}]
  2031.     file rename -force tfa1 tfa2
  2032.     set result [expr $r1 && [checkcontent tfa2 $s]]
  2033.     file delete [glob tfa1 tfa2]
  2034.     set result
  2035. } {1}
  2037. test fCmd-22.2 {TclpRenameFile: attempt to overwrite itself} {macOrUnix notRoot} {
  2038.     catch {file delete -force -- tfa1}
  2039.     set s [createfile tfa1]
  2040.     file rename -force tfa1 tfa1
  2041.     set result [checkcontent tfa1 $s]
  2042.     file delete tfa1 
  2043.     set result
  2044. } {1}
  2046. test fCmd-22.3 {TclpRenameFile: rename dir to existing dir} {notRoot} {
  2047.     catch {file delete -force -- d1 tfad}
  2048.     file mkdir d1 [file join tfad d1]
  2049.     set r1 [catch {file rename d1 tfad}]
  2050.     set result [expr $r1 && [file isdir d1] && [file isdir [file join tfad d1]]]
  2051.     file delete -force d1 tfad
  2052.     set result
  2053. } {1}
  2055. test fCmd-22.4 {TclpRenameFile: rename dir to dir several levels deep} {notRoot} {
  2056.     catch {file delete -force -- d1 tfad}
  2057.     file mkdir d1 [file join tfad a b c]
  2058.     file rename d1 [file join tfad a b c d1]
  2059.     set result [expr ![file isdir d1] && [file isdir [file join tfad a b c d1]]]
  2060.     file delete -force [glob d1 tfad]
  2061.     set result
  2062. } {1}
  2065. #
  2066. # TclMacCopyFile needs to be redone.
  2067. #
  2068. test fCmd-22.5 {TclMacCopyFile: copy and overwrite in a single dir} {notRoot} {
  2069.     catch {file delete -force -- tfa1 tfa2}
  2070.     set s [createfile tfa1]
  2071.     set s2 [createfile tfa2 q]
  2073.     set r1 [catch {file copy tfa1 tfa2}]
  2074.     file copy -force tfa1 tfa2
  2075.     set result [expr $r1 && [checkcontent tfa2 $s] && [checkcontent tfa1 $s]]
  2076.     file delete tfa1 tfa2
  2077.     set result
  2078. } {1}
  2080. #
  2081. # TclMacMkdir - basic cases are covered elsewhere.
  2082. # Error cases are not covered.
  2083. #
  2085. #
  2086. # TclMacRmdir
  2087. # Error cases are not covered.
  2088. #
  2090. test fCmd-23.1 {TclMacRmdir: trying to remove a nonempty directory} {notRoot} {
  2091.     catch {file delete -force -- tfad}
  2093.     file mkdir [file join tfad dir]
  2095.     set result [catch {file delete tfad}]
  2096.     file delete -force tfad 
  2097.     set result
  2098. } {1}
  2100. #
  2101. # TclMacDeleteFile
  2102. # Error cases are not covered.
  2103. #
  2104. test fCmd-24.1 {TclMacDeleteFile: deleting a normal file} {notRoot} {
  2105.     catch {file delete -force -- tfa1}
  2107.     createfile tfa1
  2108.     file delete tfa1
  2109.     file exists tfa1
  2110. } {0}
  2112. #
  2113. # TclMacCopyDirectory
  2114. # Error cases are not covered.
  2115. #
  2116. test fCmd-25.1 {TclMacCopyDirectory: copying a normal directory} {notRoot notFileSharing} {
  2117.     catch {file delete -force -- tfad1 tfad2}
  2119.     file mkdir [file join tfad1 a b c]
  2120.     file copy tfad1 tfad2
  2121.     set result [expr [file isdir [file join tfad1 a b c]] && [file isdir [file join tfad2 a b c]]]
  2122.     file delete -force tfad1 tfad2
  2123.     set result
  2124. } {1}
  2126. test fCmd-25.2 {TclMacCopyDirectory: copying a short path normal directory} {notRoot notFileSharing} {
  2127.     catch {file delete -force -- tfad1 tfad2}
  2129.     file mkdir tfad1
  2130.     file copy tfad1 tfad2
  2131.     set result [expr [file isdir tfad1] && [file isdir tfad2]]
  2132.     file delete tfad1 tfad2
  2133.     set result
  2134. } {1}
  2136. test fCmd-25.3 {TclMacCopyDirectory: copying dirs between different dirs} {notRoot notFileSharing} {
  2137.     catch {file delete -force -- tfad1 tfad2}
  2139.     file mkdir [file join tfad1 x y z]
  2140.     file mkdir [file join tfad2 dir]
  2141.     file copy tfad1 [file join tfad2 dir]
  2142.     set result [expr [file isdir [file join tfad1 x y z]] && [file isdir [file join tfad2 dir tfad1 x y z]]]
  2143.     file delete -force tfad1 tfad2
  2144.     set result
  2145. } {1}
  2147. #
  2148. # Functionality tests for TclDeleteFilesCmd
  2149. #
  2151. test fCmd-26.1 {TclDeleteFilesCmd: delete symlink} {unixOnly notRoot} {
  2152.     catch {file delete -force -- tfad1 tfad2}
  2154.     file mkdir tfad1
  2155.     file link -symbolic tfalink tfad1
  2156.     file delete tfalink
  2158.     set r1 [file isdir tfad1]
  2159.     set r2 [file exists tfalink]
  2160.     
  2161.     set result [expr $r1 && !$r2]
  2162.     file delete tfad1
  2163.     set result
  2164. } {1}
  2166. test fCmd-26.2 {TclDeleteFilesCmd: delete dir with symlink} {unixOnly notRoot} {
  2167.     catch {file delete -force -- tfad1 tfad2}
  2169.     file mkdir tfad1
  2170.     file mkdir tfad2
  2171.     file link -symbolic [file join tfad2 link] tfad1
  2172.     file delete -force tfad2
  2174.     set r1 [file isdir tfad1]
  2175.     set r2 [file exists tfad2]
  2176.     
  2177.     set result [expr $r1 && !$r2]
  2178.     file delete tfad1
  2179.     set result
  2180. } {1}
  2182. test fCmd-26.3 {TclDeleteFilesCmd: delete dangling symlink} {unixOnly notRoot} {
  2183.     catch {file delete -force -- tfad1 tfad2}
  2185.     file mkdir tfad1
  2186.     file link -symbolic tfad2 tfad1
  2187.     file delete tfad1
  2188.     file delete tfad2
  2190.     set r1 [file exists tfad1]
  2191.     set r2 [file exists tfad2]
  2192.     
  2193.     set result [expr !$r1 && !$r2]
  2194.     set result
  2195. } {1}
  2197. test fCmd-27.2 {TclFileAttrsCmd - Tcl_TranslateFileName fails} {testsetplatform} {
  2198.     set platform [testgetplatform]
  2199.     testsetplatform unix
  2200.     list [catch {file attributes ~_totally_bogus_user} msg] $msg [testsetplatform $platform]
  2201. } {1 {user "_totally_bogus_user" doesn't exist} {}}
  2202. test fCmd-27.3 {TclFileAttrsCmd - all attributes} {
  2203.     catch {file delete -force -- foo.tmp}
  2204.     createfile foo.tmp
  2205.     list [catch {file attributes foo.tmp} msg] [expr {[llength $msg] > 0}] [file delete -force -- foo.tmp]
  2206. } {0 1 {}}
  2207. test fCmd-27.4 {TclFileAttrsCmd - getting one option} {
  2208.     catch {file delete -force -- foo.tmp}
  2209.     createfile foo.tmp
  2210.     set attrs [file attributes foo.tmp]
  2211.     list [catch {eval file attributes foo.tmp [lindex $attrs 0]}] [file delete -force -- foo.tmp]
  2212. } {0 {}}
  2214. # Find a group that exists on this Unix system, or else skip tests that
  2215. # require Unix groups.
  2216. if {$tcl_platform(platform) == "unix"} {
  2217.     ::tcltest::testConstraint foundGroup 0
  2218.     catch {
  2219. set groupList [exec groups]
  2220. set group [lindex $groupList 0]
  2221. ::tcltest::testConstraint foundGroup 1
  2222.     }
  2223. } else {
  2224.     ::tcltest::testConstraint foundGroup 1
  2225. }
  2227. test fCmd-27.5 {TclFileAttrsCmd - setting one option} {foundGroup} {
  2228.     catch {file delete -force -- foo.tmp}
  2229.     createfile foo.tmp
  2230.     set attrs [file attributes foo.tmp]
  2231.     list [catch {eval file attributes foo.tmp [lrange $attrs 0 1]} msg] $msg [file delete -force -- foo.tmp]
  2232. } {0 {} {}}
  2233. test fCmd-27.6 {TclFileAttrsCmd - setting more than one option} {foundGroup} {
  2234.     catch {file delete -force -- foo.tmp}
  2235.     createfile foo.tmp
  2236.     set attrs [file attributes foo.tmp]
  2237.     list [catch {eval file attributes foo.tmp [lrange $attrs 0 3]} msg] $msg [file delete -force -- foo.tmp]
  2238. } {0 {} {}}
  2240. if {[string equal $tcl_platform(platform) "windows"]} {
  2241.     if {[string index $tcl_platform(osVersion) 0] >= 5 
  2242.       && ([lindex [file system [temporaryDirectory]] 1] == "NTFS")} {
  2243. tcltest::testConstraint linkDirectory 1
  2244. tcltest::testConstraint linkFile 1
  2245.     } else {
  2246. tcltest::testConstraint linkDirectory 0
  2247. tcltest::testConstraint linkFile 0
  2248.     }
  2249. } else {
  2250.     tcltest::testConstraint linkFile 1
  2251.     tcltest::testConstraint linkDirectory 1
  2252. }
  2254. test fCmd-28.1 {file link} {
  2255.     list [catch {file link} msg] $msg
  2256. } {1 {wrong # args: should be "file link ?-linktype? linkname ?target?"}}
  2258. test fCmd-28.2 {file link} {
  2259.     list [catch {file link a b c d} msg] $msg
  2260. } {1 {wrong # args: should be "file link ?-linktype? linkname ?target?"}}
  2262. test fCmd-28.3 {file link} {
  2263.     list [catch {file link abc b c} msg] $msg
  2264. } {1 {bad switch "abc": must be -symbolic or -hard}}
  2266. test fCmd-28.4 {file link} {
  2267.     list [catch {file link -abc b c} msg] $msg
  2268. } {1 {bad switch "-abc": must be -symbolic or -hard}}
  2269. cd [workingDirectory]
  2271. makeDirectory abc.dir
  2272. makeDirectory abc2.dir
  2273. makeFile contents abc.file
  2274. makeFile contents abc2.file
  2276. cd [temporaryDirectory]
  2277. test fCmd-28.5 {file link: source already exists} {linkDirectory} {
  2278.     cd [temporaryDirectory]
  2279.     set res [list [catch {file link abc.dir abc2.dir} msg] $msg]
  2280.     cd [workingDirectory]
  2281.     set res
  2282. } {1 {could not create new link "abc.dir": that path already exists}}
  2284. test fCmd-28.6 {file link: unsupported operation} {linkDirectory macOrWin} {
  2285.     cd [temporaryDirectory]
  2286.     set res [list [catch {file link -hard abc.link abc.dir} msg] $msg]
  2287.     cd [workingDirectory]
  2288.     set res
  2289. } {1 {could not create new link "abc.link" pointing to "abc.dir": illegal operation on a directory}}
  2291. test fCmd-28.7 {file link: source already exists} {linkFile} {
  2292.     cd [temporaryDirectory]
  2293.     set res [list [catch {file link abc.file abc2.file} msg] $msg]
  2294.     cd [workingDirectory]
  2295.     set res
  2296. } {1 {could not create new link "abc.file": that path already exists}}
  2298. test fCmd-28.8 {file link} {linkFile winOnly} {
  2299.     cd [temporaryDirectory]
  2300.     set res [list [catch {file link -symbolic abc.link abc.file} msg] $msg]
  2301.     cd [workingDirectory]
  2302.     set res
  2303. } {1 {could not create new link "abc.link" pointing to "abc.file": not a directory}}
  2305. test fCmd-28.9 {file link: success with file} {linkFile} {
  2306.     cd [temporaryDirectory]
  2307.     file delete -force abc.link
  2308.     set res [list [catch {file link abc.link abc.file} msg] $msg]
  2309.     cd [workingDirectory]
  2310.     set res
  2311. } {0 abc.file}
  2313. cd [temporaryDirectory]
  2314. catch {file delete -force abc.link}
  2315. cd [workingDirectory]
  2317. test fCmd-28.10 {file link: linking to nonexistent path} {linkDirectory} {
  2318.     cd [temporaryDirectory]
  2319.     file delete -force abc.link
  2320.     set res [list [catch {file link abc.link abc2.doesnt} msg] $msg]
  2321.     cd [workingDirectory]
  2322.     set res
  2323. } {1 {could not create new link "abc.link" since target "abc2.doesnt" doesn't exist}}
  2325. test fCmd-28.11 {file link: success with directory} {linkDirectory} {
  2326.     cd [temporaryDirectory]
  2327.     file delete -force abc.link
  2328.     set res [list [catch {file link abc.link abc.dir} msg] $msg]
  2329.     cd [workingDirectory]
  2330.     set res
  2331. } {0 abc.dir}
  2333. test fCmd-28.12 {file link: cd into a link} {linkDirectory} {
  2334.     cd [temporaryDirectory]
  2335.     file delete -force abc.link
  2336.     file link abc.link abc.dir
  2337.     set orig [pwd]
  2338.     cd abc.link
  2339.     set dir [pwd]
  2340.     cd ..
  2341.     set up [pwd]
  2342.     cd $orig
  2343.     # now '$up' should be either $orig or [file dirname abc.dir],
  2344.     # depending on whether 'cd' actually moves to the destination
  2345.     # of a link, or simply treats the link as a directory.
  2346.     # (on windows the former, on unix the latter, I believe)
  2347.     if {([file normalize $up] != [file normalize $orig]) 
  2348.       && ([file normalize $up] != [file normalize [file dirname abc.dir]])} {
  2349. set res "wrong directory with 'cd $link ; cd ..'"
  2350.     } else {
  2351. set res "ok"
  2352.     }
  2353.     cd [workingDirectory]
  2354.     set res
  2355. } {ok}
  2357. test fCmd-28.13 {file link} {linkDirectory} {
  2358.     # duplicate link throws error
  2359.     cd [temporaryDirectory]
  2360.     set res [list [catch {file link abc.link abc.dir} msg] $msg]
  2361.     cd [workingDirectory]
  2362.     set res
  2363. } {1 {could not create new link "abc.link": that path already exists}}
  2365. test fCmd-28.14 {file link: deletes link not dir} {linkDirectory} {
  2366.     cd [temporaryDirectory]
  2367.     file delete -force abc.link
  2368.     set res [list [file exists abc.link] [file exists abc.dir]]
  2369.     cd [workingDirectory]
  2370.     set res
  2371. } {0 1}
  2373. test fCmd-28.15.1 {file link: copies link not dir} {linkDirectory dontCopyLinks} {
  2374.     cd [temporaryDirectory]
  2375.     file delete -force abc.link
  2376.     file link abc.link abc.dir
  2377.     file copy abc.link abc2.link
  2378.     # abc2.linkdir was a copy of a link to a dir, so it should end up as
  2379.     # a directory, not a link (links trace to endpoint).
  2380.     set res [list [file type abc2.link] [file tail [file link abc.link]]]
  2381.     cd [workingDirectory]
  2382.     set res
  2383. } {directory abc.dir}
  2384. test fCmd-28.15.2 {file link: copies link not dir} {linkDirectory} {
  2385.     cd [temporaryDirectory]
  2386.     file delete -force abc.link
  2387.     file link abc.link abc.dir
  2388.     file copy abc.link abc2.link
  2389.     set res [list [file type abc2.link] [file tail [file link abc2.link]]]
  2390.     cd [workingDirectory]
  2391.     set res
  2392. } {link abc.dir}
  2394. cd [temporaryDirectory]
  2395. file delete -force abc.link
  2396. file delete -force abc2.link
  2398. file copy abc.file abc.dir
  2399. file copy abc2.file abc.dir
  2400. cd [workingDirectory]
  2402. test fCmd-28.16 {file link: glob inside link} {linkDirectory} {
  2403.     cd [temporaryDirectory]
  2404.     file delete -force abc.link
  2405.     file link abc.link abc.dir
  2406.     set res [lsort [glob -dir abc.link -tails *]]
  2407.     cd [workingDirectory]
  2408.     set res
  2409. } [lsort [list abc.file abc2.file]]
  2411. test fCmd-28.17 {file link: glob -type l} {linkDirectory} {
  2412.     cd [temporaryDirectory]
  2413.     set res [glob -dir [pwd] -type l -tails abc*]
  2414.     cd [workingDirectory]
  2415.     set res
  2416. } {abc.link}
  2418. test fCmd-28.18 {file link: glob -type d} {linkDirectory} {
  2419.     cd [temporaryDirectory]
  2420.     set res [lsort [glob -dir [pwd] -type d -tails abc*]]
  2421.     cd [workingDirectory]
  2422.     set res
  2423. } [lsort [list abc.link abc.dir abc2.dir]]
  2425. test fCmd-29.1 {weird memory corruption fault} {
  2426.     catch {set res [open [file join ~a_totally_bogus_user_id/foo bar]]}
  2427. } 1
  2429. cd [temporaryDirectory]
  2430. file delete -force abc.link
  2431. cd [workingDirectory]
  2433. removeFile abc2.file
  2434. removeFile abc.file
  2435. removeDirectory abc2.dir
  2436. removeDirectory abc.dir
  2438. # cleanup
  2439. cleanup
  2440. ::tcltest::cleanupTests
  2441. return