PageRenderTime 86ms CodeModel.GetById 36ms RepoModel.GetById 0ms app.codeStats 0ms

/brlcad/branches/dmtogl/src/other/tcl/tests/fCmd.test

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