Symaptic: os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/fCmd.test@bde4ae8d615e

     1 # This file tests the tclFCmd.c file.

2 #

     3 # This file contains a collection of tests for one or more of the Tcl

     4 # built-in commands.  Sourcing this file into Tcl runs the tests and

     5 # generates output for errors.  No output means no errors were found.

6 #

     7 # Copyright (c) 1996-1997 Sun Microsystems, Inc.

     8 # Copyright (c) 1999 by Scriptics Corporation.

     9 # Portions Copyright (c) 2007 Nokia Corporation and/or its subsidiaries. All rights reserved.

    10 #

    11 # See the file "license.terms" for information on usage and redistribution

    12 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.

    13 #

    14 # RCS: @(#) $Id: fCmd.test,v 1.26.2.9 2007/05/17 14:18:42 dgp Exp $

    15 #

    17 if {[lsearch [namespace children] ::tcltest] == -1} {

    18     package require tcltest 2

    19     namespace import -force ::tcltest::*

    20 }

    22 tcltest::testConstraint testsetplatform [string equal testsetplatform [info commands testsetplatform]]

    23 tcltest::testConstraint testchmod [string equal testchmod [info commands testchmod]]

    24 tcltest::testConstraint notNetworkFilesystem 0

    25 testConstraint 95or98 [expr {[testConstraint 95] || [testConstraint 98]}]

    26 testConstraint 2000orNewer [expr {![testConstraint 95or98]}]

    28 # Several tests require need to match results against the unix username

    29 set user {}

    30 if {$tcl_platform(platform) == "unix"} {

    31     catch {set user [exec whoami]}

    32     if {$user == ""} {

    33 	catch {regexp {^[^(]*\(([^)]*)\)} [exec id] dummy user}

    34     }

    35     if {$user == ""} {

    36 	set user "root"

    37     }

    38 }

    40 proc createfile {file {string a}} {

    41     set f [open $file w]

    42     puts -nonewline $f $string

    43     close $f

    44     return $string

    45 }

    47 #

    48 # checkcontent --

    49 #

    50 #  Ensures that file "file" contains only the string "matchString"

    51 #  returns 0 if the file does not exist, or has a different content

    52 #

    53 proc checkcontent {file matchString} {

    54     if {[catch {

    55 	set f [open $file]

    56 	set fileString [read $f]

    57 	close $f

    58     }]} {

    59 	return 0

    60     }

    61     return [string match $matchString $fileString]

    62 }

    64 proc openup {path} {

    65     testchmod 777 $path

    66     if {[file isdirectory $path]} {

    67 	catch {

    68 	    foreach p [glob -directory $path *] {

    69 		openup $p

    70 	    }

    71 	}

    72     }

    73 }

    75 proc cleanup {args} {

    76     if {$::tcl_platform(platform) == "macintosh"} {

    77 	set wd [list :]

    78     } else {

    79 	set wd [list .]

    80     }

    81     foreach p [concat $wd $args] {

    82 	set x ""

    83 	catch {

    84 	    set x [glob -directory $p tf* td*]

    85 	}

    86 	foreach file $x {

    87 	    if {[catch {file delete -force -- $file}]} {

    88 		catch {openup $file}

    89 		catch {file delete -force -- $file}

    90 	    }

    91 	}

    92     }

    93 }

    95 proc contents {file} {

    96     set f [open $file r]

    97     set r [read $f]

    98     close $f

    99     set r

   100 }

   102 cd [temporaryDirectory]

   104 set ::tcltest::testConstraints(fileSharing) 0

   105 set ::tcltest::testConstraints(notFileSharing) 1

   107 if {$tcl_platform(platform) == "macintosh"} {

   108     catch {file delete -force foo.dir}

   109     file mkdir foo.dir

   110     if {[catch {file attributes foo.dir -readonly 1}] == 0} {

   111     	set ::tcltest::testConstraints(fileSharing) 1

   112     	set ::tcltest::testConstraints(notFileSharing) 0

   113     }

   114     file delete -force foo.dir

   115 }

   117 set ::tcltest::testConstraints(xdev) 0

   119 if {$tcl_platform(platform) == "unix"} {

   120     if {[catch {set m1 [exec df .]; set m2 [exec df /tmp]}] == 0} {

   121 	set m1 [string range $m1 0 [expr [string first " " $m1]-1]]

   122 	set m2 [string range $m2 0 [expr [string first " " $m2]-1]]

   123 	if {$m1 != "" && $m2 != "" && $m1 != $m2 && [file exists $m1] && [file exists $m2]} {

   124 	    set ::tcltest::testConstraints(xdev) 1

   125 	}

   126     }

   127 }

   129 set root [lindex [file split [pwd]] 0]

   131 # A really long file name

   132 # length of long is 1216 chars, which should be greater than any static

   133 # buffer or allowable filename.

   135 set long "abcdefghihjllmnopqrstuvwxyz01234567890"

   136 append long $long

   137 append long $long

   138 append long $long

   139 append long $long

   140 append long $long

   142 test fCmd-1.1 {TclFileRenameCmd} {notRoot} {

   143     cleanup

   144     createfile tf1

   145     file rename tf1 tf2

   146     glob tf*

   147 } {tf2}

   149 test fCmd-2.1 {TclFileCopyCmd} {notRoot} {

   150     cleanup

   151     createfile tf1

   152     file copy tf1 tf2

   153     lsort [glob tf*]

   154 } {tf1 tf2}

   156 test fCmd-3.1 {FileCopyRename: FileForceOption fails} {notRoot} {

   157     list [catch {file rename -xyz} msg] $msg

   158 } {1 {bad option "-xyz": should be -force or --}}

   159 test fCmd-3.2 {FileCopyRename: not enough args} {notRoot} {

   160     list [catch {file rename xyz} msg] $msg

   161 } {1 {wrong # args: should be "file rename ?options? source ?source ...? target"}}

   162 test fCmd-3.3 {FileCopyRename: Tcl_TranslateFileName fails} {notRoot} {

   163     list [catch {file rename xyz ~_totally_bogus_user} msg] $msg

   164 } {1 {user "_totally_bogus_user" doesn't exist}}

   165 test fCmd-3.4 {FileCopyRename: Tcl_TranslateFileName passes} {notRoot} {

   166     cleanup

   167     list [catch {file copy tf1 ~} msg] $msg

   168 } {1 {error copying "tf1": no such file or directory}}

   169 test fCmd-3.5 {FileCopyRename: target doesn't exist: stat(target) != 0} {notRoot} {

   170     cleanup

   171     list [catch {file rename tf1 tf2 tf3} msg] $msg

   172 } {1 {error renaming: target "tf3" is not a directory}}

   173 test fCmd-3.6 {FileCopyRename: target tf3 is not a dir: !S_ISDIR(target)} \

   174 	{notRoot} {

   175     cleanup

   176     createfile tf3

   177     list [catch {file rename tf1 tf2 tf3} msg] $msg

   178 } {1 {error renaming: target "tf3" is not a directory}}

   179 test fCmd-3.7 {FileCopyRename: target exists & is directory} {notRoot} {

   180     cleanup

   181     file mkdir td1

   182     createfile tf1 tf1

   183     file rename tf1 td1

   184     contents [file join td1 tf1]

   185 } {tf1}

   186 test fCmd-3.8 {FileCopyRename: too many arguments: argc - i > 2} {notRoot} {

   187     cleanup

   188     list [catch {file rename tf1 tf2 tf3} msg] $msg

   189 } {1 {error renaming: target "tf3" is not a directory}}

   190 test fCmd-3.9 {FileCopyRename: too many arguments: argc - i > 2} {notRoot} {

   191     cleanup

   192     list [catch {file copy -force -- tf1 tf2 tf3} msg] $msg

   193 } {1 {error copying: target "tf3" is not a directory}}

   194 test fCmd-3.10 {FileCopyRename: just 2 arguments} {notRoot} {

   195     cleanup

   196     createfile tf1 tf1

   197     file rename tf1 tf2

   198     contents tf2

   199 } {tf1}

   200 test fCmd-3.11 {FileCopyRename: just 2 arguments} {notRoot} {

   201     cleanup

   202     createfile tf1 tf1

   203     file rename -force -force -- tf1 tf2

   204     contents tf2

   205 } {tf1}

   206 test fCmd-3.12 {FileCopyRename: move each source: 1 source} {notRoot} {

   207     cleanup

   208     createfile tf1 tf1

   209     file mkdir td1

   210     file rename tf1 td1

   211     contents [file join td1 tf1]

   212 } {tf1}

   213 test fCmd-3.13 {FileCopyRename: move each source: multiple sources} {notRoot} {

   214     cleanup

   215     createfile tf1 tf1

   216     createfile tf2 tf2

   217     createfile tf3 tf3

   218     createfile tf4 tf4

   219     file mkdir td1

   220     file rename tf1 tf2 tf3 tf4 td1

   221     list [contents [file join td1 tf1]] [contents [file join td1 tf2]] \

   222 	[contents [file join td1 tf3]] [contents [file join td1 tf4]]

   223 } {tf1 tf2 tf3 tf4}

   224 test fCmd-3.14 {FileCopyRename: FileBasename fails} {notRoot} {

   225     cleanup

   226     file mkdir td1

   227     list [catch {file rename ~_totally_bogus_user td1} msg] $msg

   228 } {1 {user "_totally_bogus_user" doesn't exist}}

   229 test fCmd-3.15 {FileCopyRename: source[0] == '\0'} {notRoot unixOrPc} {

   230     cleanup

   231     file mkdir td1

   232     list [catch {file rename / td1} msg] $msg

   233 } {1 {error renaming "/" to "td1": file already exists}}

   234 test fCmd-3.16 {FileCopyRename: break on first error} {notRoot} {

   235     cleanup

   236     createfile tf1

   237     createfile tf2

   238     createfile tf3

   239     createfile tf4

   240     file mkdir td1

   241     createfile [file join td1 tf3]

   242     list [catch {file rename tf1 tf2 tf3 tf4 td1} msg] $msg

   243 } [subst {1 {error renaming "tf3" to "[file join td1 tf3]": file already exists}}]

   245 test fCmd-4.1 {TclFileMakeDirsCmd: make each dir: 1 dir} {notRoot} {

   246     cleanup

   247     file mkdir td1

   248     glob td*

   249 } {td1}

   250 test fCmd-4.2 {TclFileMakeDirsCmd: make each dir: multiple dirs} {notRoot} {

   251     cleanup

   252     file mkdir td1 td2 td3

   253     lsort [glob td*]

   254 } {td1 td2 td3}

   255 test fCmd-4.3 {TclFileMakeDirsCmd: stops on first error} {notRoot} {

   256     cleanup

   257     createfile tf1

   258     catch {file mkdir td1 td2 tf1 td3 td4}

   259     glob td1 td2 tf1 td3 td4

   260 } {td1 td2 tf1}

   261 test fCmd-4.4 {TclFileMakeDirsCmd: Tcl_TranslateFileName fails} {notRoot} {

   262     cleanup

   263     list [catch {file mkdir ~_totally_bogus_user} msg] $msg

   264 } {1 {user "_totally_bogus_user" doesn't exist}}

   265 test fCmd-4.5 {TclFileMakeDirsCmd: Tcl_SplitPath returns 0: *name == '\0'} \

   266 	{notRoot} {

   267     cleanup

   268     list [catch {file mkdir ""} msg] $msg

   269 } {1 {can't create directory "": no such file or directory}}

   270 test fCmd-4.6 {TclFileMakeDirsCmd: one level deep} {notRoot} {

   271     cleanup

   272     file mkdir td1

   273     glob td1

   274 } {td1}

   275 test fCmd-4.7 {TclFileMakeDirsCmd: multi levels deep} {notRoot} {

   276     cleanup

   277     file mkdir [file join td1 td2 td3 td4]

   278     glob td1 [file join td1 td2]

   279 } "td1 [file join td1 td2]"

   280 test fCmd-4.8 {TclFileMakeDirsCmd: already exist: lstat(target) == 0} {notRoot} {

   281     cleanup

   282     file mkdir td1

   283     set x [file exists td1]

   284     file mkdir td1

   285     list $x [file exists td1]

   286 } {1 1}

   287 test fCmd-4.9 {TclFileMakeDirsCmd: exists, not dir} {notRoot} {

   288     cleanup

   289     createfile tf1

   290     list [catch {file mkdir tf1} msg] $msg

   291 } [subst {1 {can't create directory "[file join tf1]": file already exists}}]

   292 test fCmd-4.10 {TclFileMakeDirsCmd: exists, is dir} {notRoot} {

   293     cleanup

   294     file mkdir td1

   295     set x [file exists td1]

   296     file mkdir td1

   297     list $x [file exists td1]

   298 } {1 1}

   299 test fCmd-4.11 {TclFileMakeDirsCmd: doesn't exist: errno != ENOENT} \

   300 	{unixOnly notRoot testchmod} {

   301     cleanup

   302     file mkdir td1/td2/td3

   303     testchmod 000 td1/td2

   304     set msg [list [catch {file mkdir td1/td2/td3/td4} msg] $msg]

   305     testchmod 755 td1/td2

   306     set msg

   307 } {1 {can't create directory "td1/td2/td3": permission denied}}

   308 test fCmd-4.12 {TclFileMakeDirsCmd: doesn't exist: errno != ENOENT} {macOnly} {

   309     cleanup

   310     list [catch {file mkdir nonexistentvolume:} msg] $msg

   311 } {1 {can't create directory "nonexistentvolume:": invalid argument}}

   312 test fCmd-4.13 {TclFileMakeDirsCmd: doesn't exist: errno == ENOENT} {notRoot} {

   313     cleanup

   314     set x [file exists td1]

   315     file mkdir td1

   316     list $x [file exists td1]

   317 } {0 1}

   318 test fCmd-4.14 {TclFileMakeDirsCmd: TclpCreateDirectory fails} \

   319 	{unixOnly notRoot} {

   320     cleanup

   321     file delete -force foo

   322     file mkdir foo

   323     file attr foo -perm 040000

   324     set result [list [catch {file mkdir foo/tf1} msg] $msg]

   325     file delete -force foo

   326     set result

   327 } {1 {can't create directory "foo/tf1": permission denied}}

   328 test fCmd-4.15 {TclFileMakeDirsCmd: TclpCreateDirectory fails} {macOnly} {

   329     list [catch {file mkdir ${root}:} msg] $msg

   330 } [subst {1 {can't create directory "${root}:": no such file or directory}}]

   331 test fCmd-4.16 {TclFileMakeDirsCmd: TclpCreateDirectory succeeds} {notRoot} {

   332     cleanup

   333     file mkdir tf1

   334     file exists tf1

   335 } {1}

   337 test fCmd-5.1 {TclFileDeleteCmd: FileForceOption fails} {notRoot} {

   338     list [catch {file delete -xyz} msg] $msg

   339 } {1 {bad option "-xyz": should be -force or --}}

   340 test fCmd-5.2 {TclFileDeleteCmd: not enough args} {notRoot} {

   341     list [catch {file delete -force -force} msg] $msg

   342 } {1 {wrong # args: should be "file delete ?options? file ?file ...?"}}

   343 test fCmd-5.3 {TclFileDeleteCmd: 1 file} {notRoot} {

   344     cleanup

   345     createfile tf1

   346     createfile tf2

   347     file mkdir td1

   348     file delete tf2

   349     glob tf* td*

   350 } {tf1 td1}

   351 test fCmd-5.4 {TclFileDeleteCmd: multiple files} {notRoot} {

   352     cleanup

   353     createfile tf1

   354     createfile tf2

   355     file mkdir td1

   356     set x [list [file exists tf1] [file exists tf2] [file exists td1]]

   357     file delete tf1 td1 tf2

   358     lappend x [file exists tf1] [file exists tf2] [file exists tf3]

   359 } {1 1 1 0 0 0}

   360 test fCmd-5.5 {TclFileDeleteCmd: stop at first error} {notRoot unixOrPc} {

   361     cleanup

   362     createfile tf1

   363     createfile tf2

   364     file mkdir td1

   365     catch {file delete tf1 td1 $root tf2}

   366     list [file exists tf1] [file exists tf2] [file exists td1]

   367 } {0 1 0}

   368 test fCmd-5.6 {TclFileDeleteCmd: Tcl_TranslateFileName fails} {notRoot} {

   369     list [catch {file delete ~_totally_bogus_user} msg] $msg

   370 } {1 {user "_totally_bogus_user" doesn't exist}}

   371 test fCmd-5.7 {TclFileDeleteCmd: Tcl_TranslateFileName succeeds} {notRoot} {

   372     catch {file delete ~/tf1}

   373     createfile ~/tf1

   374     file delete ~/tf1

   375 } {}

   376 test fCmd-5.8 {TclFileDeleteCmd: file doesn't exist: lstat(name) != 0} {notRoot} {

   377     cleanup

   378     set x [file exists tf1]

   379     file delete tf1

   380     list $x [file exists tf1]

   381 } {0 0}

   382 test fCmd-5.9 {TclFileDeleteCmd: is directory} {notRoot} {

   383     cleanup

   384     file mkdir td1

   385     file delete td1

   386     file exists td1

   387 } {0}

   388 test fCmd-5.10 {TclFileDeleteCmd: TclpRemoveDirectory fails} {notRoot} {

   389     cleanup

   390     file mkdir [file join td1 td2]

   391     list [catch {file delete td1} msg] $msg

   392 } {1 {error deleting "td1": directory not empty}}

   393 test fCmd-5.11 {TclFileDeleteCmd: TclpRemoveDirectory with cwd inside} {notRoot} {

   394     cleanup

   395     set dir [pwd]

   396     file mkdir [file join td1 td2]

   397     cd [file join td1 td2]

   398     set res [list [catch {file delete -force [file dirname [pwd]]} msg]]

   399     cd $dir

   400     lappend res [file exists td1] $msg

   401 } {0 0 {}}

   402 test fCmd-5.12 {TclFileDeleteCmd: TclpRemoveDirectory with bad perms} {unixOnly} {

   403     cleanup

   404     file mkdir [file join td1 td2]

   405     #exec chmod u-rwx [file join td1 td2]

   406     file attributes [file join td1 td2] -permissions u+rwx

   407     set res [list [catch {file delete -force td1} msg]]

   408     lappend res [file exists td1] $msg

   409 } {0 0 {}}

   411 test fCmd-6.1 {CopyRenameOneFile: bad source} {notRoot} {

   412     # can't test this, because it's caught by FileCopyRename

   413 } {}

   414 test fCmd-6.2 {CopyRenameOneFile: bad target} {notRoot} {

   415     # can't test this, because it's caught by FileCopyRename

   416 } {}

   417 test fCmd-6.3 {CopyRenameOneFile: lstat(source) != 0} {notRoot} {

   418     cleanup

   419     list [catch {file rename tf1 tf2} msg] $msg

   420 } {1 {error renaming "tf1": no such file or directory}}

   421 test fCmd-6.4 {CopyRenameOneFile: lstat(source) == 0} {notRoot} {

   422     cleanup

   423     createfile tf1

   424     file rename tf1 tf2

   425     glob tf*

   426 } {tf2}

   427 test fCmd-6.5 {CopyRenameOneFile: lstat(target) != 0} {notRoot} {

   428     cleanup

   429     createfile tf1

   430     file rename tf1 tf2

   431     glob tf*

   432 } {tf2}

   433 test fCmd-6.6 {CopyRenameOneFile: errno != ENOENT} {unixOnly notRoot testchmod} {

   434     cleanup

   435     file mkdir td1

   436     testchmod 000 td1

   437     createfile tf1

   438     set msg [list [catch {file rename tf1 td1} msg] $msg]

   439     testchmod 755 td1

   440     set msg

   441 } {1 {error renaming "tf1" to "td1/tf1": permission denied}}

   442 test fCmd-6.7 {CopyRenameOneFile: errno != ENOENT} {pcOnly 95} {

   443     cleanup

   444     createfile tf1

   445     list [catch {file rename tf1 $long} msg] $msg

   446 } [subst {1 {error renaming "tf1" to "$long": file name too long}}]

   447 test fCmd-6.8 {CopyRenameOneFile: errno != ENOENT} {macOnly} {

   448     cleanup

   449     createfile tf1

   450     list [catch {file rename tf1 $long} msg] $msg

   451 } [subst {1 {error renaming "tf1" to "$long": file name too long}}]

   452 test fCmd-6.9 {CopyRenameOneFile: errno == ENOENT} {unixOnly notRoot} {

   453     cleanup

   454     createfile tf1

   455     file rename tf1 tf2

   456     glob tf*

   457 } {tf2}

   458 test fCmd-6.10 {CopyRenameOneFile: lstat(target) == 0} {notRoot} {

   459     cleanup

   460     createfile tf1

   461     createfile tf2

   462     list [catch {file rename tf1 tf2} msg] $msg

   463 } {1 {error renaming "tf1" to "tf2": file already exists}}

   464 test fCmd-6.11 {CopyRenameOneFile: force == 0} {notRoot} {

   465     cleanup

   466     createfile tf1

   467     createfile tf2

   468     list [catch {file rename tf1 tf2} msg] $msg

   469 } {1 {error renaming "tf1" to "tf2": file already exists}}

   470 test fCmd-6.12 {CopyRenameOneFile: force != 0} {notRoot} {

   471     cleanup

   472     createfile tf1

   473     createfile tf2

   474     file rename -force tf1 tf2

   475     glob tf*

   476 } {tf2}

   477 test fCmd-6.13 {CopyRenameOneFile: source is dir, target is file} {notRoot} {

   478     cleanup

   479     file mkdir td1

   480     file mkdir td2

   481     createfile [file join td2 td1]

   482     list [catch {file rename -force td1 td2} msg] $msg

   483 } [subst {1 {can't overwrite file "[file join td2 td1]" with directory "td1"}}]

   484 test fCmd-6.14 {CopyRenameOneFile: source is file, target is dir} {notRoot} {

   485     cleanup

   486     createfile tf1

   487     file mkdir [file join td1 tf1]

   488     list [catch {file rename -force tf1 td1} msg] $msg

   489 } [subst {1 {can't overwrite directory "[file join td1 tf1]" with file "tf1"}}]

   490 test fCmd-6.15 {CopyRenameOneFile: TclpRenameFile succeeds} {notRoot notNetworkFilesystem} {

   491     cleanup

   492     file mkdir [file join td1 td2]

   493     file mkdir td2

   494     createfile [file join td2 tf1]

   495     file rename -force td2 td1

   496     file exists [file join td1 td2 tf1]

   497 } {1}

   498 test fCmd-6.16 {CopyRenameOneFile: TclpCopyRenameOneFile fails} {notRoot} {

   499     cleanup

   500     file mkdir [file join td1 td2]

   501     createfile [file join td1 td2 tf1]

   502     file mkdir td2

   503     list [catch {file rename -force td2 td1} msg] $msg

   504 } [subst {1 {error renaming "td2" to "[file join td1 td2]": file already exists}}]

   506 test fCmd-6.17 {CopyRenameOneFile: errno == EINVAL} {notRoot} {

   507     cleanup

   508     list [catch {file rename -force $root tf1} msg] $msg

   509 } [subst {1 {error renaming "$root" to "tf1": trying to rename a volume or move a directory into itself}}]

   510 test fCmd-6.18 {CopyRenameOneFile: errno != EXDEV} {notRoot} {

   511     cleanup

   512     file mkdir [file join td1 td2]

   513     createfile [file join td1 td2 tf1]

   514     file mkdir td2

   515     list [catch {file rename -force td2 td1} msg] $msg

   516 } [subst {1 {error renaming "td2" to "[file join td1 td2]": file already exists}}]

   517 test fCmd-6.19 {CopyRenameOneFile: errno == EXDEV} {unixOnly notRoot} {

   518     cleanup /tmp

   519     createfile tf1

   520     file rename tf1 /tmp

   521     glob tf* /tmp/tf1

   522 } {/tmp/tf1}

   523 test fCmd-6.20 {CopyRenameOneFile: errno == EXDEV} {pcOnly} {

   524     catch {file delete -force c:/tcl8975@ d:/tcl8975@}

   525     file mkdir c:/tcl8975@

   526     if [catch {file rename c:/tcl8975@ d:/}] {

   527 	set msg d:/tcl8975@

   528     } else {

   529 	set msg [glob c:/tcl8975@ d:/tcl8975@]

   530 	file delete -force d:/tcl8975@

   531     }

   532     file delete -force c:/tcl8975@

   533     set msg

   534 } {d:/tcl8975@}

   535 test fCmd-6.21 {CopyRenameOneFile: copy/rename: S_ISDIR(source)} \

   536 	{unixOnly notRoot} {

   537     cleanup /tmp

   538     file mkdir td1

   539     file rename td1 /tmp

   540     glob td* /tmp/td*

   541 } {/tmp/td1}

   542 test fCmd-6.22 {CopyRenameOneFile: copy/rename: !S_ISDIR(source)} \

   543 	{unixOnly notRoot} {

   544     cleanup /tmp

   545     createfile tf1

   546     file rename tf1 /tmp

   547     glob tf* /tmp/tf*

   548 } {/tmp/tf1}

   549 test fCmd-6.23 {CopyRenameOneFile: TclpCopyDirectory failed} \

   550 	{unixOnly notRoot xdev} {

   551     cleanup /tmp

   552     file mkdir td1/td2/td3

   553     file attributes td1 -permissions 0000

   554     set msg [list [catch {file rename td1 /tmp} msg] $msg]

   555     file attributes td1 -permissions 0755

   556     set msg

   557 } {1 {error renaming "td1": permission denied}}

   558 test fCmd-6.24 {CopyRenameOneFile: error uses original name} \

   559 	{unixOnly notRoot} {

   560     cleanup

   561     file mkdir ~/td1/td2

   562     set td1name [file join [file dirname ~] [file tail ~] td1]

   563     file attributes $td1name -permissions 0000

   564     set msg [list [catch {file copy ~/td1 td1} msg] $msg]

   565     file attributes $td1name -permissions 0755

   566     file delete -force ~/td1

   567     set msg

   568 } {1 {error copying "~/td1": permission denied}}

   569 test fCmd-6.25 {CopyRenameOneFile: error uses original name} \

   570 	{unixOnly notRoot} {

   571     cleanup

   572     file mkdir td2

   573     file mkdir ~/td1

   574     set td1name [file join [file dirname ~] [file tail ~] td1]

   575     file attributes $td1name -permissions 0000

   576     set msg [list [catch {file copy td2 ~/td1} msg] $msg]

   577     file attributes $td1name -permissions 0755

   578     file delete -force ~/td1

   579     set msg

   580 } {1 {error copying "td2" to "~/td1/td2": permission denied}}

   581 test fCmd-6.26 {CopyRenameOneFile: doesn't use original name} \

   582 	{unixOnly notRoot} {

   583     cleanup

   584     file mkdir ~/td1/td2

   585     set td2name [file join [file dirname ~] [file tail ~] td1 td2]

   586     file attributes $td2name -permissions 0000

   587     set msg [list [catch {file copy ~/td1 td1} msg] $msg]

   588     file attributes $td2name -permissions 0755

   589     file delete -force ~/td1

   590     set msg

   591 } "1 {error copying \"~/td1\" to \"td1\": \"[file join [file dirname ~] [file tail ~] td1 td2]\": permission denied}"

   592 test fCmd-6.27 {CopyRenameOneFile: TclpCopyDirectory failed} \

   593 	{unixOnly notRoot xdev} {

   594     cleanup /tmp

   595     file mkdir td1/td2/td3

   596     file mkdir /tmp/td1

   597     createfile /tmp/td1/tf1

   598     list [catch {file rename -force td1 /tmp} msg] $msg

   599 } {1 {error renaming "td1" to "/tmp/td1": file already exists}}

   600 test fCmd-6.28 {CopyRenameOneFile: TclpCopyDirectory failed} \

   601 	{unixOnly notRoot xdev} {

   602     cleanup /tmp

   603     file mkdir td1/td2/td3

   604     file attributes td1/td2/td3 -permissions 0000

   605     set msg [list [catch {file rename td1 /tmp} msg] $msg]

   606     file attributes td1/td2/td3 -permissions 0755

   607     set msg

   608 } {1 {error renaming "td1" to "/tmp/td1": "td1/td2/td3": permission denied}}

   609 test fCmd-6.29 {CopyRenameOneFile: TclpCopyDirectory passed} \

   610 	{unixOnly notRoot xdev} {

   611     cleanup /tmp

   612     file mkdir td1/td2/td3

   613     file rename td1 /tmp

   614     glob td* /tmp/td1/t*

   615 } {/tmp/td1/td2}

   616 test fCmd-6.30 {CopyRenameOneFile: TclpRemoveDirectory failed} \

   617 	{unixOnly notRoot} {

   618     cleanup

   619     file mkdir foo/bar

   620     file attr foo -perm 040555

   621     set catchResult [catch {file rename foo/bar /tmp} msg]

   622     set msg [lindex [split $msg :] end]

   623     catch {file delete /tmp/bar}

   624     catch {file attr foo -perm 040777}

   625     catch {file delete -force foo}

   626     list $catchResult $msg

   627 } {1 { permission denied}}

   628 test fCmd-6.31 {CopyRenameOneFile: TclpDeleteFile passed} \

   629 	{unixOnly notRoot xdev} {

   630     catch {cleanup /tmp}

   631     file mkdir /tmp/td1

   632     createfile /tmp/td1/tf1

   633     file rename /tmp/td1/tf1 tf1

   634     list [file exists /tmp/td1/tf1] [file exists tf1]

   635 } {0 1}

   636 test fCmd-6.32 {CopyRenameOneFile: copy} {notRoot} {

   637     cleanup

   638     list [catch {file copy tf1 tf2} msg] $msg

   639 } {1 {error copying "tf1": no such file or directory}}

   640 catch {cleanup /tmp}

   642 test fCmd-7.1 {FileForceOption: none} {notRoot} {

   643     cleanup

   644     file mkdir [file join tf1 tf2]

   645     list [catch {file delete tf1} msg] $msg

   646 } {1 {error deleting "tf1": directory not empty}}

   647 test fCmd-7.2 {FileForceOption: -force} {notRoot} {

   648     cleanup

   649     file mkdir [file join tf1 tf2]

   650     file delete -force tf1

   651 } {}

   652 test fCmd-7.3 {FileForceOption: --} {notRoot} {

   653     createfile -tf1

   654     file delete -- -tf1

   655 } {}

   656 test fCmd-7.4 {FileForceOption: bad option} {notRoot} {

   657     createfile -tf1

   658     set msg [list [catch {file delete -tf1} msg] $msg]

   659     file delete -- -tf1

   660     set msg

   661 } {1 {bad option "-tf1": should be -force or --}}

   662 test fCmd-7.5 {FileForceOption: multiple times through loop} {notRoot} {

   663     createfile --

   664     createfile -force

   665     file delete -force -force -- -- -force

   666     list [catch {glob -- -- -force} msg] $msg

   667 } {1 {no files matched glob patterns "-- -force"}}

   669 test fCmd-8.1 {FileBasename: basename of ~user: argc == 1 && *path == ~} \

   670 	{unixOnly notRoot knownBug} {

   671     # Labelled knownBug because it is dangerous [Bug: 3881]

   672     file mkdir td1

   673     file attr td1 -perm 040000

   674     set result [list [catch {file rename ~$user td1} msg] $msg]

   675     file delete -force td1

   676     set result

   677 } "1 {error renaming \"~$user\" to \"td1/[file tail ~$user]\": permission denied}"

   678 test fCmd-8.2 {FileBasename: basename of ~user: argc == 1 && *path == ~} {

   679     string equal [file tail ~$user] ~$user

   680 } 0

   681 test fCmd-8.3 {file copy and path translation: ensure correct error} {

   682     list [catch {file copy ~ [file join this file doesnt exist]} res] $res

   683 } [list 1 \

   684   "error copying \"~\" to \"[file join this file doesnt exist]\":\

   685   no such file or directory"]

   687 test fCmd-9.1 {file rename: comprehensive: EACCES} {unixOnly notRoot} {

   688     cleanup

   689     file mkdir td1

   690     file mkdir td2

   691     file attr td2 -perm 040000

   692     set result [list [catch {file rename td1 td2/} msg] $msg]

   693     file delete -force td2

   694     file delete -force td1

   695     set result

   696 } {1 {error renaming "td1" to "td2/td1": permission denied}}

   697 test fCmd-9.2 {file rename: comprehensive: source doesn't exist} {notRoot} {

   698     cleanup

   699     list [catch {file rename tf1 tf2} msg] $msg

   700 } {1 {error renaming "tf1": no such file or directory}}

   701 test fCmd-9.3 {file rename: comprehensive: file to new name} {notRoot testchmod} {

   702     cleanup

   703     createfile tf1

   704     createfile tf2

   705     testchmod 444 tf2

   706     file rename tf1 tf3

   707     file rename tf2 tf4

   708     list [lsort [glob tf*]] [file writable tf3] [file writable tf4]

   709 } {{tf3 tf4} 1 0}

   710 test fCmd-9.4 {file rename: comprehensive: dir to new name} {unixOrPc notRoot testchmod} {

   711     cleanup

   712     file mkdir td1 td2

   713     testchmod 555 td2

   714     file rename td1 td3

   715     file rename td2 td4

   716     list [lsort [glob td*]] [file writable td3] [file writable td4]

   717 } {{td3 td4} 1 0}

   718 test fCmd-9.5 {file rename: comprehensive: file to self} {notRoot testchmod} {

   719     cleanup

   720     createfile tf1 tf1

   721     createfile tf2 tf2

   722     testchmod 444 tf2

   723     file rename -force tf1 tf1

   724     file rename -force tf2 tf2

   725     list [contents tf1] [contents tf2] [file writable tf1] [file writable tf2]

   726 } {tf1 tf2 1 0}

   727 test fCmd-9.6 {file rename: comprehensive: dir to self} {notRoot unixOrPc testchmod} {

   728     cleanup

   729     file mkdir td1

   730     file mkdir td2

   731     testchmod 555 td2

   732     file rename -force td1 .

   733     file rename -force td2 .

   734     list [lsort [glob td*]] [file writable td1] [file writable td2]

   735 } {{td1 td2} 1 0}

   736 test fCmd-9.7 {file rename: comprehensive: file to existing file} {notRoot testchmod} {

   737     cleanup

   738     createfile tf1

   739     createfile tf2

   740     createfile tfs1

   741     createfile tfs2

   742     createfile tfs3

   743     createfile tfs4

   744     createfile tfd1

   745     createfile tfd2

   746     createfile tfd3

   747     createfile tfd4

   748     testchmod 444 tfs3

   749     testchmod 444 tfs4

   750     testchmod 444 tfd2

   751     testchmod 444 tfd4

   752     set msg [list [catch {file rename tf1 tf2} msg] $msg]

   753     file rename -force tfs1 tfd1

   754     file rename -force tfs2 tfd2

   755     file rename -force tfs3 tfd3

   756     file rename -force tfs4 tfd4

   757     list [lsort [glob tf*]] $msg [file writable tfd1] [file writable tfd2] [file writable tfd3] [file writable tfd4]

   758 } {{tf1 tf2 tfd1 tfd2 tfd3 tfd4} {1 {error renaming "tf1" to "tf2": file already exists}} 1 1 0 0}

   759 test fCmd-9.8 {file rename: comprehensive: dir to empty dir} {notRoot testchmod notNetworkFilesystem} {

   760     # Under unix, you can rename a read-only directory, but you can't

   761     # move it into another directory.

   763     cleanup

   764     file mkdir td1

   765     file mkdir [file join td2 td1]

   766     file mkdir tds1

   767     file mkdir tds2

   768     file mkdir tds3

   769     file mkdir tds4

   770     file mkdir [file join tdd1 tds1]

   771     file mkdir [file join tdd2 tds2]

   772     file mkdir [file join tdd3 tds3]

   773     file mkdir [file join tdd4 tds4]

   774     if {$tcl_platform(platform) != "unix" && $tcl_platform(platform) != "macintosh"} {

   775 	testchmod 555 tds3

   776 	testchmod 555 tds4

   777     }

   778     if {$tcl_platform(platform) != "macintosh"} {

   779     	testchmod 555 [file join tdd2 tds2]

   780     	testchmod 555 [file join tdd4 tds4]

   781     }

   782     set msg [list [catch {file rename td1 td2} msg] $msg]

   783     file rename -force tds1 tdd1

   784     file rename -force tds2 tdd2

   785     file rename -force tds3 tdd3

   786     file rename -force tds4 tdd4

   787     if {$tcl_platform(platform) != "unix" && $tcl_platform(platform) != "macintosh"} {

   788 	set w3 [file writable [file join tdd3 tds3]]

   789 	set w4 [file writable [file join tdd4 tds4]]

   790     } else {

   791 	set w3 0

   792 	set w4 0

   793     }

   794     list [lsort [glob td*]] $msg [file writable [file join tdd1 tds1]] \

   795     [file writable [file join tdd2 tds2]] $w3 $w4

   796 } [subst {{td1 td2 tdd1 tdd2 tdd3 tdd4} {1 {error renaming "td1" to "[file join td2 td1]": file already exists}} 1 1 0 0}]

   797 test fCmd-9.9 {file rename: comprehensive: dir to non-empty dir} {notRoot testchmod} {

   798     cleanup

   799     file mkdir tds1

   800     file mkdir tds2

   801     file mkdir [file join tdd1 tds1 xxx]

   802     file mkdir [file join tdd2 tds2 xxx]

   803     if {$tcl_platform(platform) != "unix" && $tcl_platform(platform) != "macintosh"} {

   804 	testchmod 555 tds2

   805     }

   806     set a1 [list [catch {file rename -force tds1 tdd1} msg] $msg]

   807     set a2 [list [catch {file rename -force tds2 tdd2} msg] $msg]

   808     if {$tcl_platform(platform) != "unix" && $tcl_platform(platform) != "macintosh"} {

   809 	set w2 [file writable tds2]

   810     } else {

   811 	set w2 0

   812     }

   813     list [lsort [glob td*]] $a1 $a2 [file writable tds1] $w2

   814 } [subst {{tdd1 tdd2 tds1 tds2} {1 {error renaming "tds1" to "[file join tdd1 tds1]": file already exists}} {1 {error renaming "tds2" to "[file join tdd2 tds2]": file already exists}} 1 0}]

   815 test fCmd-9.10 {file rename: comprehensive: file to new name and dir} {notRoot testchmod} {

   816     cleanup

   817     createfile tf1

   818     createfile tf2

   819     file mkdir td1

   820     testchmod 444 tf2

   821     file rename tf1 [file join td1 tf3]

   822     file rename tf2 [file join td1 tf4]

   823     list [catch {glob tf*}] [lsort [glob -directory td1 t*]] \

   824     [file writable [file join td1 tf3]] [file writable [file join td1 tf4]]

   825 } [subst {1 {[file join td1 tf3] [file join td1 tf4]} 1 0}]

   826 test fCmd-9.11 {file rename: comprehensive: dir to new name and dir} {notRoot testchmod} {

   827     cleanup

   828     file mkdir td1

   829     file mkdir td2

   830     file mkdir td3

   831     if {$tcl_platform(platform) != "unix" && $tcl_platform(platform) != "macintosh"} {

   832 	testchmod 555 td2

   833     }

   834     file rename td1 [file join td3 td3]

   835     file rename td2 [file join td3 td4]

   836     if {$tcl_platform(platform) != "unix" && $tcl_platform(platform) != "macintosh"} {

   837 	set w4 [file writable [file join td3 td4]]

   838     } else {

   839         set w4 0

   840     }

   841     list [lsort [glob td*]] [lsort [glob -directory td3 t*]] \

   842     [file writable [file join td3 td3]] $w4

   843 } [subst {td3 {[file join td3 td3] [file join td3 td4]} 1 0}]

   844 test fCmd-9.12 {file rename: comprehensive: target exists} {notRoot testchmod notNetworkFilesystem} {

   845     cleanup

   846     file mkdir [file join td1 td2] [file join td2 td1]

   847     if {$tcl_platform(platform) != "macintosh"} {

   848     	testchmod 555 [file join td2 td1]

   849     }

   850     file mkdir [file join td3 td4] [file join td4 td3]

   851     file rename -force td3 td4

   852     set msg [list [file exists td3] [file exists [file join td4 td3 td4]] \

   853     [catch {file rename td1 td2} msg] $msg]

   854     if {$tcl_platform(platform) != "macintosh"} {

   855     	testchmod 755 [file join td2 td1]

   856     }

   857     set msg

   858 } [subst {0 1 1 {error renaming "td1" to "[file join td2 td1]": file already exists}}]

   859 test fCmd-9.13 {file rename: comprehensive: can't overwrite target} {notRoot} {

   860     cleanup

   861     file mkdir [file join td1 td2] [file join td2 td1 td4]

   862     list [catch {file rename -force td1 td2} msg] $msg

   863 } [subst {1 {error renaming "td1" to "[file join td2 td1]": file already exists}}]

   864 test fCmd-9.14 {file rename: comprehensive: dir into self} {notRoot} {

   865     cleanup

   866     file mkdir td1

   867     list [glob td*] [list [catch {file rename td1 td1} msg] $msg]

   868 } [subst {td1 {1 {error renaming "td1" to "[file join td1 td1]": trying to rename a volume or move a directory into itself}}}]

   869 test fCmd-9.15 {file rename: comprehensive: source and target incompatible} \

   870 	{notRoot} {

   871     cleanup

   872     file mkdir td1

   873     createfile tf1

   874     list [catch {file rename -force td1 tf1} msg] $msg

   875 } {1 {can't overwrite file "tf1" with directory "td1"}}

   876 test fCmd-9.16 {file rename: comprehensive: source and target incompatible} \

   877 	{notRoot} {

   878     cleanup

   879     file mkdir td1/tf1

   880     createfile tf1

   881     list [catch {file rename -force tf1 td1} msg] $msg

   882 } [subst {1 {can't overwrite directory "[file join td1 tf1]" with file "tf1"}}]

   884 test fCmd-10.1 {file copy: comprehensive: source doesn't exist} {notRoot} {

   885     cleanup

   886     list [catch {file copy tf1 tf2} msg] $msg

   887 } {1 {error copying "tf1": no such file or directory}}

   888 test fCmd-10.2 {file copy: comprehensive: file to new name} {notRoot testchmod} {

   889     cleanup

   890     createfile tf1 tf1

   891     createfile tf2 tf2

   892     testchmod 444 tf2

   893     file copy tf1 tf3

   894     file copy tf2 tf4

   895     list [lsort [glob tf*]] [contents tf3] [contents tf4] [file writable tf3] [file writable tf4]

   896 } {{tf1 tf2 tf3 tf4} tf1 tf2 1 0}

   897 test fCmd-10.3 {file copy: comprehensive: dir to new name} {notRoot unixOrPc 95or98 testchmod} {

   898     cleanup

   899     file mkdir [file join td1 tdx]

   900     file mkdir [file join td2 tdy]

   901     testchmod 555 td2

   902     file copy td1 td3

   903     file copy td2 td4

   904     set msg [list [lsort [glob td*]] [glob -directory td3 t*] \

   905 	    [glob -directory td4 t*] [file writable td3] [file writable td4]]

   906     if {$tcl_platform(platform) != "macintosh"} {

   907     	testchmod 755 td2

   908     	testchmod 755 td4

   909     }

   910     set msg

   911 } [subst {{td1 td2 td3 td4} [file join td3 tdx] [file join td4 tdy] 1 0}]

   912 test fCmd-10.3.1 {file copy: comprehensive: dir to new name} {notRoot pc 2000orNewer testchmod} {

   913     # On Windows with ACLs, copying a directory is defined like this

   914     cleanup

   915     file mkdir [file join td1 tdx]

   916     file mkdir [file join td2 tdy]

   917     testchmod 555 td2

   918     file copy td1 td3

   919     file copy td2 td4

   920     set msg [list [lsort [glob td*]] [glob -directory td3 t*] \

   921 	    [glob -directory td4 t*] [file writable td3] [file writable td4]]

   922     testchmod 755 td2

   923     testchmod 755 td4

   924     set msg

   925 } [subst {{td1 td2 td3 td4} [file join td3 tdx] [file join td4 tdy] 1 1}]

   926 test fCmd-10.4 {file copy: comprehensive: file to existing file} {notRoot testchmod} {

   927     cleanup

   928     createfile tf1

   929     createfile tf2

   930     createfile tfs1

   931     createfile tfs2

   932     createfile tfs3

   933     createfile tfs4

   934     createfile tfd1

   935     createfile tfd2

   936     createfile tfd3

   937     createfile tfd4

   938     testchmod 444 tfs3

   939     testchmod 444 tfs4

   940     testchmod 444 tfd2

   941     testchmod 444 tfd4

   942     set msg [list [catch {file copy tf1 tf2} msg] $msg]

   943     file copy -force tfs1 tfd1

   944     file copy -force tfs2 tfd2

   945     file copy -force tfs3 tfd3

   946     file copy -force tfs4 tfd4

   947     list [lsort [glob tf*]] $msg [file writable tfd1] [file writable tfd2] [file writable tfd3] [file writable tfd4]

   948 } {{tf1 tf2 tfd1 tfd2 tfd3 tfd4 tfs1 tfs2 tfs3 tfs4} {1 {error copying "tf1" to "tf2": file already exists}} 1 1 0 0}

   949 test fCmd-10.5 {file copy: comprehensive: dir to empty dir} {notRoot testchmod} {

   950     cleanup

   951     file mkdir td1

   952     file mkdir [file join td2 td1]

   953     file mkdir tds1

   954     file mkdir tds2

   955     file mkdir tds3

   956     file mkdir tds4

   957     file mkdir [file join tdd1 tds1]

   958     file mkdir [file join tdd2 tds2]

   959     file mkdir [file join tdd3 tds3]

   960     file mkdir [file join tdd4 tds4]

   961     if {$tcl_platform(platform) != "macintosh"} {

   962 	testchmod 555 tds3

   963 	testchmod 555 tds4

   964 	testchmod 555 [file join tdd2 tds2]

   965 	testchmod 555 [file join tdd4 tds4]

   966     }

   967     set a1 [list [catch {file copy td1 td2} msg] $msg]

   968     set a2 [list [catch {file copy -force tds1 tdd1} msg] $msg]

   969     set a3 [catch {file copy -force tds2 tdd2}]

   970     set a4 [catch {file copy -force tds3 tdd3}]

   971     set a5 [catch {file copy -force tds4 tdd4}]

   972     list [lsort [glob td*]] $a1 $a2 $a3 $a4 $a5

   973 } [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}]

   974 test fCmd-10.6 {file copy: comprehensive: dir to non-empty dir} \

   975 	{notRoot unixOrPc testchmod} {

   976     cleanup

   977     file mkdir tds1

   978     file mkdir tds2

   979     file mkdir [file join tdd1 tds1 xxx]

   980     file mkdir [file join tdd2 tds2 xxx]

   981     testchmod 555 tds2

   982     set a1 [list [catch {file copy -force tds1 tdd1} msg] $msg]

   983     set a2 [list [catch {file copy -force tds2 tdd2} msg] $msg]

   984     list [lsort [glob td*]] $a1 $a2 [file writable tds1] [file writable tds2]

   985 } [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}]

   986 test fCmd-10.7 {file rename: comprehensive: file to new name and dir} {notRoot testchmod} {

   987     cleanup

   988     createfile tf1

   989     createfile tf2

   990     file mkdir td1

   991     testchmod 444 tf2

   992     file copy tf1 [file join td1 tf3]

   993     file copy tf2 [file join td1 tf4]

   994     list [lsort [glob tf*]] [lsort [glob -directory td1 t*]] \

   995     [file writable [file join td1 tf3]] [file writable [file join td1 tf4]]

   996 } [subst {{tf1 tf2} {[file join td1 tf3] [file join td1 tf4]} 1 0}]

   997 test fCmd-10.8 {file rename: comprehensive: dir to new name and dir} \

   998 	{notRoot unixOrPc 95or98 testchmod} {

   999     cleanup

  1000     file mkdir td1

  1001     file mkdir td2

  1002     file mkdir td3

  1003     testchmod 555 td2

  1004     file copy td1 [file join td3 td3]

  1005     file copy td2 [file join td3 td4]

  1006     list [lsort [glob td*]] [lsort [glob -directory td3 t*]] \

  1007     [file writable [file join td3 td3]] [file writable [file join td3 td4]]

  1008 } [subst {{td1 td2 td3} {[file join td3 td3] [file join td3 td4]} 1 0}]

  1009 test fCmd-10.8.1 {file rename: comprehensive: dir to new name and dir} \

  1010 	{notRoot pc 2000orNewer testchmod} {

  1011     # On Windows with ACLs, copying a directory is defined like this

  1012     cleanup

  1013     file mkdir td1

  1014     file mkdir td2

  1015     file mkdir td3

  1016     testchmod 555 td2

  1017     file copy td1 [file join td3 td3]

  1018     file copy td2 [file join td3 td4]

  1019     list [lsort [glob td*]] [lsort [glob -directory td3 t*]] \

  1020     [file writable [file join td3 td3]] [file writable [file join td3 td4]]

  1021 } [subst {{td1 td2 td3} {[file join td3 td3] [file join td3 td4]} 1 1}]

  1022 test fCmd-10.9 {file copy: comprehensive: source and target incompatible} \

  1023 	{notRoot} {

  1024     cleanup

  1025     file mkdir td1

  1026     createfile tf1

  1027     list [catch {file copy -force td1 tf1} msg] $msg

  1028 } {1 {can't overwrite file "tf1" with directory "td1"}}

  1029 test fCmd-10.10 {file copy: comprehensive: source and target incompatible} \

  1030 	{notRoot} {

  1031     cleanup

  1032     file mkdir [file join td1 tf1]

  1033     createfile tf1

  1034     list [catch {file copy -force tf1 td1} msg] $msg

  1035 } [subst {1 {can't overwrite directory "[file join td1 tf1]" with file "tf1"}}]

  1036 test fCmd-10.11 {file copy: copy to empty file name} {

  1037     cleanup

  1038     createfile tf1

  1039     list [catch {file copy tf1 ""} msg] $msg

  1040 } {1 {error copying "tf1" to "": no such file or directory}}

  1041 test fCmd-10.12 {file rename: rename to empty file name} {

  1042     cleanup

  1043     createfile tf1

  1044     list [catch {file rename tf1 ""} msg] $msg

  1045 } {1 {error renaming "tf1" to "": no such file or directory}}

  1046 cleanup

  1048 # old tests

  1050 test fCmd-11.1 {TclFileRenameCmd: -- option } {notRoot} {

  1051     catch {file delete -force -- -tfa1}

  1052     set s [createfile -tfa1]

  1053     file rename -- -tfa1 tfa2

  1054     set result [expr [checkcontent tfa2 $s] && ![file exists -tfa1]]

  1055     file delete tfa2

  1056     set result

  1057 } {1}

  1059 test fCmd-11.2 {TclFileRenameCmd: bad option } {notRoot} {

  1060     catch {file delete -force -- tfa1}

  1061     set s [createfile tfa1]

  1062     set r1 [catch {file rename -x tfa1 tfa2}]

  1063     set result [expr $r1 && [checkcontent tfa1 $s] && ![file exists tfa2]]

  1064     file delete tfa1

  1065     set result

  1066 } {1}

  1068 test fCmd-11.3 {TclFileRenameCmd: bad \# args} {

  1069     catch {file rename -- }

  1070 } {1}

  1072 test fCmd-11.4 {TclFileRenameCmd: target filename translation failing} {notRoot} {

  1073      global env

  1074      set temp $env(HOME)

  1075      unset env(HOME)

  1076      set result [catch {file rename tfa ~/foobar }]

  1077      set env(HOME) $temp

  1078      set result

  1079  } {1}

  1081 test fCmd-11.5 {TclFileRenameCmd: > 1 source & target is not a dir} {notRoot} {

  1082     catch {file delete -force -- tfa1 tfa2 tfa3}

  1083     createfile tfa1

  1084     createfile tfa2

  1085     createfile tfa3

  1086     set result [catch {file rename tfa1 tfa2 tfa3}]

  1087     file delete tfa1 tfa2 tfa3

  1088     set result

  1089 } {1}

  1091 test fCmd-11.6 {TclFileRenameCmd: : single file into directory} {notRoot} {

  1092     catch {file delete -force -- tfa1 tfad}

  1093     set s [createfile tfa1]

  1094     file mkdir tfad

  1095     file rename tfa1 tfad

  1096     set result [expr [checkcontent tfad/tfa1 $s] && ![file exists tfa1]]

  1097     file delete -force tfad

  1098     set result

  1099 } {1}

  1101 test fCmd-11.7 {TclFileRenameCmd: : multiple files into directory} {notRoot} {

  1102     catch {file delete -force -- tfa1 tfa2 tfad}

  1103     set s1 [createfile tfa1 ]

  1104     set s2 [createfile tfa2 ]

  1105     file mkdir tfad

  1106     file rename tfa1 tfa2 tfad

  1107     set r1 [checkcontent tfad/tfa1 $s1]

  1108     set r2 [checkcontent tfad/tfa2 $s2]

  1110     set result [expr $r1 && $r2 && ![file exists tfa1] && ![file exists tfa2]]

  1112     file delete -force tfad

  1113     set result

  1114 } {1}

  1116 test fCmd-11.8 {TclFileRenameCmd: error renaming file to directory} {notRoot} {

  1117     catch {file delete -force -- tfa tfad}

  1118     set s [createfile tfa ]

  1119     file mkdir tfad

  1120     file mkdir tfad/tfa

  1121     set r1 [catch {file rename tfa tfad}]

  1122     set r2 [checkcontent tfa $s]

  1123     set r3 [file isdir tfad]

  1124     set result [expr $r1 && $r2 && $r3 ]

  1125     file delete -force tfa tfad

  1126     set result

  1127 } {1}

  1129 #

  1130 # Coverage tests for renamefile() ;

  1131 #

  1132 test fCmd-12.1 {renamefile: source filename translation failing} {notRoot} {

  1133     global env

  1134     set temp $env(HOME)

  1135     unset env(HOME)

  1136     set result [catch {file rename ~/tfa1 tfa2}]

  1137     set env(HOME) $temp

  1138     set result

  1139 } {1}

  1141 test fCmd-12.2 {renamefile: src filename translation failing} {notRoot} {

  1142     global env

  1143     set temp $env(HOME)

  1144     unset env(HOME)

  1145     set s [createfile tfa1]

  1146     file mkdir tfad

  1147     set result [catch {file rename tfa1 ~/tfa2 tfad}]

  1148     set env(HOME) $temp

  1149     file delete -force tfad

  1150     set result

  1151 } {1}

  1153 test fCmd-12.3 {renamefile: stat failing on source} {notRoot} {

  1154     catch {file delete -force -- tfa1 tfa2}

  1155     set r1 [catch {file rename tfa1 tfa2}]

  1156     expr {$r1 && ![file exists tfa1] && ![file exists tfa2]}

  1157 } {1}

  1159 test fCmd-12.4 {renamefile: error renaming file to directory} {notRoot} {

  1160     catch {file delete -force -- tfa tfad}

  1161     set s1 [createfile tfa ]

  1162     file mkdir tfad

  1163     file mkdir tfad/tfa

  1164     set r1 [catch {file rename tfa tfad}]

  1165     set r2 [checkcontent tfa $s1]

  1166     set r3 [file isdir tfad/tfa]

  1167     set result [expr $r1 && $r2 && $r3]

  1168     file delete -force tfa tfad

  1169     set result

  1170 } {1}

  1172 test fCmd-12.5 {renamefile: error renaming directory to file} {notRoot} {

  1173     catch {file delete -force -- tfa tfad}

  1174     file mkdir tfa

  1175     file mkdir tfad

  1176     set s [createfile tfad/tfa]

  1177     set r1 [catch {file rename tfa tfad}]

  1178     set r2 [checkcontent tfad/tfa $s]

  1179     set r3 [file isdir tfad]

  1180     set r4 [file isdir tfa]

  1181     set result [expr $r1 && $r2 && $r3 && $r4 ]

  1182     file delete -force tfa tfad

  1183     set result

  1184 } {1}

  1186 test fCmd-12.6 {renamefile: TclRenameFile succeeding} {notRoot} {

  1187     catch {file delete -force -- tfa1 tfa2}

  1188     set s [createfile tfa1]

  1189     file rename tfa1 tfa2

  1190     set result [expr [checkcontent tfa2 $s] && ![file exists tfa1]]

  1191     file delete tfa2

  1192     set result

  1193 } {1}

  1195 test fCmd-12.7 {renamefile: renaming directory into offspring} {notRoot} {

  1196     catch {file delete -force -- tfad}

  1197     file mkdir tfad

  1198     file mkdir tfad/dir

  1199     set result [catch {file rename tfad tfad/dir}]

  1200     file delete -force tfad

  1201     set result

  1202 } {1}

  1204 test fCmd-12.8 {renamefile: generic error} {unixOnly notRoot} {

  1205     catch {file delete -force -- tfa}

  1206     file mkdir tfa

  1207     file mkdir tfa/dir

  1208     file attributes tfa -permissions 0555

  1209     set result [catch {file rename tfa/dir tfa2}]

  1210     file attributes tfa -permissions 0777

  1211     file delete -force tfa

  1212     set result

  1213 } {1}

  1216 test fCmd-12.9 {renamefile: moving a file across volumes} {unixOnly notRoot} {

  1217     catch {file delete -force -- tfa /tmp/tfa}

  1218     set s [createfile tfa ]

  1219     file rename tfa /tmp

  1220     set result [expr [checkcontent /tmp/tfa $s] && ![file exists tfa]]

  1221     file delete /tmp/tfa

  1222     set result

  1223 } {1}

  1225 test fCmd-12.10 {renamefile: moving a directory across volumes } \

  1226 	{unixOnly notRoot} {

  1227     catch {file delete -force -- tfad /tmp/tfad}

  1228     file mkdir tfad

  1229     set s [createfile tfad/a ]

  1230     file rename tfad /tmp

  1231     set restul [expr [checkcontent /tmp/tfad/a $s] && ![file exists tfad]]

  1232     file delete -force /tmp/tfad

  1233     set result

  1234 } {1}

  1236 #

  1237 # Coverage tests for TclCopyFilesCmd()

  1238 #

  1239 test fCmd-13.1 {TclCopyFilesCmd: -force option} {notRoot} {

  1240     catch {file delete -force -- tfa1}

  1241     set s [createfile tfa1]

  1242     file copy -force  tfa1 tfa2

  1243     set result [expr [checkcontent tfa2 $s] && [checkcontent tfa1 $s]]

  1244     file delete tfa1 tfa2

  1245     set result

  1246 } {1}

  1248 test fCmd-13.2 {TclCopyFilesCmd: -- option} {notRoot} {

  1249     catch {file delete -force -- tfa1}

  1250     set s [createfile -tfa1]

  1251     file copy --  -tfa1 tfa2

  1252     set result [expr [checkcontent tfa2 $s] &&  [checkcontent -tfa1 $s]]

  1253     file delete -- -tfa1 tfa2

  1254     set result

  1255 } {1}

  1257 test fCmd-13.3 {TclCopyFilesCmd: bad option} {notRoot} {

  1258     catch {file delete -force -- tfa1}

  1259     set s [createfile tfa1]

  1260     set r1 [catch {file copy -x tfa1 tfa2}]

  1261     set result [expr $r1 && [checkcontent tfa1 $s] && ![file exists tfa2]]

  1262     file delete tfa1

  1263     set result

  1264 } {1}

  1266 test fCmd-13.4 {TclCopyFilesCmd: bad \# args} {notRoot} {

  1267     catch {file copy -- }

  1268 } {1}

  1270 test fCmd-13.5 {TclCopyFilesCmd: target filename translation failing} {

  1271      global env

  1272      set temp $env(HOME)

  1273     unset env(HOME)

  1274      set result [catch {file copy tfa ~/foobar }]

  1275      set env(HOME) $temp

  1276      set result

  1277  } {1}

  1279 test fCmd-13.6 {TclCopyFilesCmd: > 1 source & target is not a dir} {notRoot} {

  1280     catch {file delete -force -- tfa1 tfa2 tfa3}

  1281     createfile tfa1

  1282     createfile tfa2

  1283     createfile tfa3

  1284     set result [catch {file copy tfa1 tfa2 tfa3}]

  1285     file delete tfa1 tfa2 tfa3

  1286     set result

  1287 } {1}

  1289 test fCmd-13.7 {TclCopyFilesCmd: single file into directory} {notRoot} {

  1290     catch {file delete -force -- tfa1 tfad}

  1291     set s [createfile tfa1]

  1292     file mkdir tfad

  1293     file copy tfa1 tfad

  1294     set result [expr [checkcontent tfad/tfa1 $s] &&  [checkcontent tfa1 $s]]

  1295     file delete -force tfad tfa1

  1296     set result

  1297 } {1}

  1299 test fCmd-13.8 {TclCopyFilesCmd: multiple files into directory} {notRoot} {

  1300     catch {file delete -force -- tfa1 tfa2 tfad}

  1301     set s1 [createfile tfa1 ]

  1302     set s2 [createfile tfa2 ]

  1303     file mkdir tfad

  1304     file copy tfa1 tfa2 tfad

  1305     set r1 [checkcontent tfad/tfa1 $s1]

  1306     set r2 [checkcontent tfad/tfa2 $s2]

  1307     set r3 [checkcontent tfa1 $s1]

  1308     set r4 [checkcontent tfa2 $s2]

  1309     set result [expr $r1 && $r2 && $r3 && $r4 ]

  1311     file delete -force tfad tfa1 tfa2

  1312     set result

  1313 } {1}

  1315 test fCmd-13.9 {TclCopyFilesCmd: error copying file to directory} {notRoot} {

  1316     catch {file delete -force -- tfa tfad}

  1317     set s [createfile tfa ]

  1318     file mkdir tfad

  1319     file mkdir tfad/tfa

  1320     set r1 [catch {file copy tfa tfad}]

  1321     set r2 [expr [checkcontent tfa $s] && [file isdir tfad/tfa]]

  1322     set r3 [file isdir tfad]

  1323     set result [expr $r1 && $r2 && $r3 ]

  1324     file delete -force tfa tfad

  1325     set result

  1326 } {1}

  1328 #

  1329 # Coverage tests for copyfile()

  1330 #

  1331 test fCmd-14.1 {copyfile: source filename translation failing} {notRoot} {

  1332     global env

  1333     set temp $env(HOME)

  1334     unset env(HOME)

  1335     set result [catch {file copy ~/tfa1 tfa2}]

  1336     set env(HOME) $temp

  1337     set result

  1338 } {1}

  1340 test fCmd-14.2 {copyfile: dst filename translation failing} {notRoot} {

  1341     global env

  1342     set temp $env(HOME)

  1343     unset env(HOME)

  1344     set s [createfile tfa1]

  1345     file mkdir tfad

  1346     set r1 [catch {file copy tfa1 ~/tfa2 tfad}]

  1347     set result [expr $r1 && [checkcontent tfad/tfa1 $s]]

  1348     set env(HOME) $temp

  1349     file delete -force tfa1 tfad

  1350     set result

  1351 } {1}

  1353 test fCmd-14.3 {copyfile: stat failing on source} {notRoot} {

  1354     catch {file delete -force -- tfa1 tfa2}

  1355     set r1 [catch {file copy tfa1 tfa2}]

  1356     expr $r1 && ![file exists tfa1] && ![file exists tfa2]

  1357 } {1}

  1359 test fCmd-14.4 {copyfile: error copying file to directory} {notRoot} {

  1360     catch {file delete -force -- tfa tfad}

  1361     set s1 [createfile tfa ]

  1362     file mkdir tfad

  1363     file mkdir tfad/tfa

  1364     set r1 [catch {file copy tfa tfad}]

  1365     set r2 [checkcontent tfa $s1]

  1366     set r3 [file isdir tfad]

  1367     set r4 [file isdir tfad/tfa]

  1368     set result [expr $r1 && $r2 && $r3 && $r4 ]

  1369     file delete -force tfa tfad

  1370     set result

  1371 } {1}

  1373  test fCmd-14.5 {copyfile: error copying directory to file} {notRoot} {

  1374      catch {file delete -force -- tfa tfad}

  1375      file mkdir tfa

  1376      file mkdir tfad

  1377      set s [createfile tfad/tfa]

  1378      set r1 [catch {file copy tfa tfad}]

  1379      set r2 [checkcontent tfad/tfa $s]

  1380      set r3 [file isdir tfad]

  1381      set r4 [file isdir tfa]

  1382      set result [expr $r1 && $r2 && $r3 && $r4 ]

  1383      file delete -force tfa tfad

  1384      set result

  1385 } {1}

  1387 test fCmd-14.6 {copyfile: copy file succeeding} {notRoot} {

  1388     catch {file delete -force -- tfa tfa2}

  1389     set s [createfile tfa]

  1390     file copy tfa tfa2

  1391     set result [expr  [checkcontent tfa $s] && [checkcontent tfa2 $s]]

  1392     file delete tfa tfa2

  1393     set result

  1394 } {1}

  1396 test fCmd-14.7 {copyfile: copy directory succeeding} {notRoot} {

  1397     catch {file delete -force -- tfa tfa2}

  1398     file mkdir tfa

  1399     set s [createfile tfa/file]

  1400     file copy tfa tfa2

  1401     set result [expr [checkcontent tfa/file $s] && [checkcontent tfa2/file $s]]

  1402     file delete -force tfa tfa2

  1403     set result

  1404 } {1}

  1406 test fCmd-14.8 {copyfile: copy directory failing} {unixOnly notRoot} {

  1407     catch {file delete -force -- tfa}

  1408     file mkdir tfa/dir/a/b/c

  1409     file attributes tfa/dir -permissions 0000

  1410     set r1 [catch {file copy tfa tfa2}]

  1411     file attributes tfa/dir -permissions 0777

  1412     set result $r1

  1413     file delete -force tfa tfa2

  1414     set result

  1415 } {1}

  1417 #

  1418 # Coverage tests for TclMkdirCmd()

  1419 #

  1420 test fCmd-15.1 {TclMakeDirsCmd: target filename translation failing} {notRoot} {

  1421     global env

  1422     set temp $env(HOME)

  1423     unset env(HOME)

  1424     set result [catch {file mkdir ~/tfa}]

  1425     set env(HOME) $temp

  1426     set result

  1427 } {1}

  1428 #

  1429 # Can Tcl_SplitPath return argc == 0? If so them we need a

  1430 # test for that code.

  1431 #

  1432 test fCmd-15.2 {TclMakeDirsCmd - one directory } {notRoot} {

  1433     catch {file delete -force -- tfa}

  1434     file mkdir tfa

  1435     set result [file isdirectory tfa]

  1436     file delete tfa

  1437     set result

  1438 } {1}

  1440 test fCmd-15.3 {TclMakeDirsCmd: - two directories} {notRoot} {

  1441     catch {file delete -force -- tfa1 tfa2}

  1442     file mkdir tfa1 tfa2

  1443     set result [expr [file isdirectory tfa1] && [file isdirectory tfa2]]

  1444     file delete tfa1 tfa2

  1445     set result

  1446 } {1}

  1448 test fCmd-15.4 {TclMakeDirsCmd - stat failing} {unixOnly notRoot} {

  1449     catch {file delete -force -- tfa}

  1450     file mkdir tfa

  1451     createfile tfa/file

  1452     file attributes tfa -permissions 0000

  1453     set result [catch {file mkdir tfa/file}]

  1454     file attributes tfa -permissions 0777

  1455     file delete -force tfa

  1456     set result

  1457 } {1}

  1459 test fCmd-15.5 {TclMakeDirsCmd: - making a directory several levels deep} \

  1460 	{notRoot} {

  1461     catch {file delete -force -- tfa}

  1462     file mkdir tfa/a/b/c

  1463     set result [file isdir tfa/a/b/c]

  1464     file delete -force tfa

  1465     set result

  1466 } {1}

  1469 test fCmd-15.6 {TclMakeDirsCmd: - trying to overwrite a file} {notRoot} {

  1470     catch {file delete -force -- tfa}

  1471     set s [createfile tfa]

  1472     set r1 [catch {file mkdir tfa}]

  1473     set r2 [file isdir tfa]

  1474     set r3 [file exists tfa]

  1475     set result [expr $r1 && !$r2 && $r3 && [checkcontent tfa $s]]

  1476     file delete tfa

  1477     set result

  1478 } {1}

  1480 test fCmd-15.7 {TclMakeDirsCmd - making several directories} {notRoot} {

  1481     catch {file delete -force -- tfa1 tfa2}

  1482     file mkdir tfa1 tfa2/a/b/c

  1483     set result [expr [file isdir tfa1] && [file isdir tfa2/a/b/c]]

  1484     file delete -force tfa1 tfa2

  1485     set result

  1486 } {1}

  1488 test fCmd-15.8 {TclFileMakeDirsCmd: trying to create an existing dir} {notRoot} {

  1489     file mkdir tfa

  1490     file mkdir tfa

  1491     set result [file isdir tfa]

  1492     file delete tfa

  1493     set result

  1494 } {1}

  1497 # Coverage tests for TclDeleteFilesCommand()

  1498 test fCmd-16.1 {test the -- argument} {notRoot} {

  1499     catch {file delete -force -- tfa}

  1500     createfile tfa

  1501     file delete -- tfa

  1502     file exists tfa

  1503 } {0}

  1505 test fCmd-16.2 {test the -force and -- arguments} {notRoot} {

  1506     catch {file delete -force -- tfa}

  1507     createfile tfa

  1508     file delete -force -- tfa

  1509     file exists tfa

  1510 } {0}

  1512 test fCmd-16.3 {test bad option} {notRoot} {

  1513     catch {file delete -force -- tfa}

  1514     createfile tfa

  1515     set result [catch {file delete -dog tfa}]

  1516     file delete tfa

  1517     set result

  1518 } {1}

  1520 test fCmd-16.4 {test not enough args} {notRoot} {

  1521     catch {file delete}

  1522 } {1}

  1524 test fCmd-16.5 {test not enough args with options} {notRoot} {

  1525     catch {file delete --}

  1526 } {1}

  1528 test fCmd-16.6 {delete: source filename translation failing} {notRoot} {

  1529     global env

  1530     set temp $env(HOME)

  1531     unset env(HOME)

  1532     set result [catch {file delete ~/tfa}]

  1533     set env(HOME) $temp

  1534     set result

  1535 } {1}

  1537 test fCmd-16.7 {remove a non-empty directory without -force } {notRoot} {

  1538     catch {file delete -force -- tfa}

  1539     file mkdir tfa

  1540     createfile tfa/a

  1541     set result [catch  {file delete tfa }]

  1542     file delete -force tfa

  1543     set result

  1544 } {1}

  1546 test fCmd-16.8 {remove a normal file } {notRoot} {

  1547     catch {file delete -force -- tfa}

  1548     file mkdir tfa

  1549     createfile tfa/a

  1550     set result [catch  {file delete tfa }]

  1551     file delete -force tfa

  1552     set result

  1553 } {1}

  1555 test fCmd-16.9 {error while deleting file } {unixOnly notRoot} {

  1556     catch {file delete -force -- tfa}

  1557     file mkdir tfa

  1558     createfile tfa/a

  1559     file attributes tfa -permissions 0555

  1560     set result [catch  {file delete tfa/a }]

  1561     #######

  1562     #######  If any directory in a tree that is being removed does not

  1563     #######  have write permission, the process will fail!

  1564     #######  This is also the case with "rm -rf"

  1565     #######

  1566     file attributes tfa -permissions 0777

  1567     file delete -force tfa

  1568     set result

  1569 } {1}

  1571 test fCmd-16.10 {deleting multiple files} {notRoot} {

  1572     catch {file delete -force -- tfa1 tfa2}

  1573     createfile tfa1

  1574     createfile tfa2

  1575     file delete tfa1 tfa2

  1576     expr ![file exists tfa1] && ![file exists tfa2]

  1577 } {1}

  1579 test fCmd-16.11 {TclFileDeleteCmd: removing a nonexistant file} {notRoot} {

  1580     catch {file delete -force -- tfa}

  1581     file delete tfa

  1582     set result 1

  1583 } {1}

  1585 # More coverage tests for mkpath()

  1586  test fCmd-17.1 {mkdir stat failing on target but not ENOENT} {unixOnly notRoot} {

  1587      catch {file delete -force -- tfa1}

  1588      file mkdir tfa1

  1589      file attributes tfa1 -permissions 0555

  1590      set result [catch {file mkdir tfa1/tfa2}]

  1591      file attributes tfa1 -permissions 0777

  1592      file delete -force tfa1

  1593      set result

  1594 } {1}

  1596 test fCmd-17.2 {mkdir several levels deep - relative } {notRoot} {

  1597     catch {file delete -force -- tfa}

  1598     file mkdir tfa/a/b

  1599     set result [file isdir tfa/a/b ]

  1600     file delete tfa/a/b tfa/a tfa

  1601     set result

  1602 } {1}

  1604 test fCmd-17.3 {mkdir several levels deep - absolute } {notRoot} {

  1605     catch {file delete -force -- tfa}

  1606     set f [file join [pwd] tfa a ]

  1607     file mkdir $f

  1608     set result [file isdir $f ]

  1609     file delete $f [file join [pwd] tfa]

  1610     set result

  1611 } {1}

  1613 #

  1614 # Functionality tests for TclFileRenameCmd()

  1615 #

  1617 test fCmd-18.1 {TclFileRenameCmd: rename (first form) in the same directory} \

  1618 	{notRoot} {

  1619     catch {file delete -force -- tfad}

  1620     file mkdir tfad/dir

  1621     cd tfad/dir

  1622     set s [createfile foo ]

  1623     file rename  foo bar

  1624     file rename bar ./foo

  1625     file rename ./foo bar

  1626     file rename ./bar ./foo

  1627     file rename foo ../dir/bar

  1628     file rename ../dir/bar ./foo

  1629     file rename ../../tfad/dir/foo ../../tfad/dir/bar

  1630     file rename [file join [pwd] bar] foo

  1631     file rename foo [file join [pwd] bar]

  1632     set result [expr [checkcontent bar $s] && ![file exists foo]]

  1633     cd ../..

  1634     file delete -force tfad

  1635     set result

  1636 } {1}

  1638 test fCmd-18.2 {TclFileRenameCmd: single dir to nonexistant} {notRoot} {

  1639     catch {file delete -force -- tfa1 tfa2}

  1640     file mkdir tfa1

  1641     file rename tfa1 tfa2

  1642     set result [expr [file exists tfa2] && ![file exists tfa1]]

  1643     file delete tfa2

  1644     set result

  1645 } {1}

  1647 test fCmd-18.3 {TclFileRenameCmd: mixed dirs and files into directory} {notRoot} {

  1648     catch {file delete -force -- tfa1 tfad1 tfad2}

  1649     set s [createfile tfa1 ]

  1650     file mkdir tfad1 tfad2

  1651     file rename tfa1 tfad1 tfad2

  1652     set r1 [checkcontent  tfad2/tfa1 $s]

  1653     set r2 [file isdir tfad2/tfad1]

  1654     set result [expr $r1 && $r2 && ![file exists tfa1] && ![file exists tfad1]]

  1655     file delete tfad2/tfa1

  1656     file delete -force tfad2

  1657     set result

  1658 } {1}

  1660 test fCmd-18.4 {TclFileRenameCmd: attempt to replace non-dir with dir} {notRoot} {

  1661     catch {file delete -force -- tfa tfad}

  1662     set s [createfile tfa ]

  1663     file mkdir tfad

  1664     set r1 [catch {file rename tfad tfa}]

  1665     set r2 [checkcontent tfa $s]

  1666     set r3 [file isdir tfad]

  1667     set result [expr $r1 && $r2 && $r3 ]

  1668     file delete tfa tfad

  1669     set result

  1670 } {1}

  1672 test fCmd-18.5 {TclFileRenameCmd: attempt to replace dir with non-dir} {notRoot} {

  1673     catch {file delete -force -- tfa tfad}

  1674     set s [createfile tfa ]

  1675     file mkdir tfad/tfa

  1676     set r1 [catch {file rename tfa tfad}]

  1677     set r2 [checkcontent tfa $s]

  1678     set r3 [file isdir tfad/tfa]

  1679     set result [expr $r1 && $r2 && $r3 ]

  1680     file delete -force  tfa tfad

  1681     set result

  1682 } {1}

  1684 #

  1685 # On Windows there is no easy way to determine if two files are the same

  1686 #

  1687 test fCmd-18.6 {TclFileRenameCmd: rename a file to itself} {macOrUnix notRoot} {

  1688     catch {file delete -force -- tfa}

  1689     set s [createfile tfa]

  1690     set r1 [catch {file rename tfa tfa}]

  1691     set result [expr $r1 && [checkcontent tfa $s]]

  1692     file delete tfa

  1693     set result

  1694 } {1}

  1696 test fCmd-18.7 {TclFileRenameCmd: rename dir on top of another empty dir w/o -force} \

  1697 	{notRoot} {

  1698     catch {file delete -force -- tfa tfad}

  1699     file mkdir tfa tfad/tfa

  1700     set r1 [catch {file rename tfa tfad}]

  1701     set result [expr $r1 && [file isdir tfa]]

  1702     file delete -force tfa tfad

  1703     set result

  1704 } {1}

  1706 test fCmd-18.8 {TclFileRenameCmd: rename dir on top of another empty dir w/ -force} \

  1707 	{notRoot notNetworkFilesystem} {

  1708     catch {file delete -force -- tfa tfad}

  1709     file mkdir tfa tfad/tfa

  1710     file rename -force tfa tfad

  1711     set result [expr ![file isdir tfa]]

  1712     file delete -force tfad

  1713     set result

  1714 } {1}

  1716 test fCmd-18.9 {TclFileRenameCmd: rename dir on top of a non-empty dir w/o -force} \

  1717 	{notRoot} {

  1718     catch {file delete -force -- tfa tfad}

  1719     file mkdir tfa tfad/tfa/file

  1720     set r1 [catch {file rename tfa tfad}]

  1721     set result [expr $r1 && [file isdir tfa] && [file isdir tfad/tfa/file]]

  1722     file delete -force tfa tfad

  1723     set result

  1724 } {1}

  1726 test fCmd-18.10 {TclFileRenameCmd: rename dir on top of a non-empty dir w/ -force} \

  1727 	{notRoot notNetworkFilesystem} {

  1728     catch {file delete -force -- tfa tfad}

  1729     file mkdir tfa tfad/tfa/file

  1730     set r1 [catch {file rename -force tfa tfad}]

  1731     set result [expr $r1 && [file isdir tfa] && [file isdir tfad/tfa/file]]

  1732     file delete -force tfa tfad

  1733     set result

  1734 } {1}

  1736 test fCmd-18.11 {TclFileRenameCmd: rename a non-existant file} {notRoot} {

  1737     catch {file delete -force -- tfa1}

  1738     set r1 [catch {file rename tfa1 tfa2}]

  1739     set result [expr $r1 && ![file exists tfa1] && ![file exists tfa2]]

  1740 } {1}

  1742 test fCmd-18.12 {TclFileRenameCmd : rename a symbolic link to file} \

  1743 	{unixOnly notRoot} {

  1744     catch {file delete -force -- tfa1 tfa2 tfa3}

  1746     set s [createfile tfa1]

  1747     file link -symbolic tfa2 tfa1

  1748     file rename tfa2 tfa3

  1749     set t [file type tfa3]

  1750     set result [expr {$t eq "link"}]

  1751     file delete tfa1 tfa3

  1752     set result

  1753 } {1}

  1755 test fCmd-18.13 {TclFileRenameCmd : rename a symbolic link to dir} \

  1756 	{unixOnly notRoot} {

  1757     catch {file delete -force -- tfa1 tfa2 tfa3}

  1759     file mkdir tfa1

  1760     file link -symbolic tfa2 tfa1

  1761     file rename tfa2 tfa3

  1762     set t [file type tfa3]

  1763     set result [expr {$t eq "link"}]

  1764     file delete tfa1 tfa3

  1765     set result

  1766 } {1}

  1768 test fCmd-18.14 {TclFileRenameCmd : rename a path with sym link} \

  1769 	{unixOnly notRoot} {

  1770     catch {file delete -force -- tfa1 tfa2 tfa3}

  1772     file mkdir tfa1/a/b/c/d

  1773     file mkdir tfa2

  1774     set f [file join [pwd] tfa1/a/b]

  1775     set f2 [file join [pwd] {tfa2/b alias}]

  1776     file link -symbolic $f2 $f

  1777     file rename {tfa2/b alias/c} tfa3

  1778     set r1 [file isdir tfa3]

  1779     set r2 [file exists tfa1/a/b/c]

  1780     set result [expr $r1 && !$r2]

  1781     file delete -force tfa1 tfa2 tfa3

  1782     set result

  1783 } {1}

  1785 test fCmd-18.15 {TclFileRenameCmd : rename a file to a symlink dir} \

  1786 	{unixOnly notRoot} {

  1787     catch {file delete -force -- tfa1 tfa2 tfalink}

  1789     file mkdir tfa1

  1790     set s [createfile tfa2]

  1791     file link -symbolic tfalink tfa1

  1793     file rename tfa2 tfalink

  1794     set result [checkcontent tfa1/tfa2 $s ]

  1795     file delete -force tfa1 tfalink

  1796     set result

  1797 } {1}

  1799 test fCmd-18.16 {TclFileRenameCmd: rename a dangling symlink} {unixOnly notRoot} {

  1800     catch {file delete -force -- tfa1 tfalink}

  1802     file mkdir tfa1

  1803     file link -symbolic tfalink tfa1

  1804     file delete tfa1

  1805     file rename tfalink tfa2

  1806     set result [expr [string compare [file type tfa2] "link"] == 0]

  1807     file delete tfa2

  1808     set result

  1809 } {1}

  1812 #

  1813 # Coverage tests for TclUnixRmdir

  1814 #

  1815 test fCmd-19.1 {remove empty directory} {notRoot} {

  1816     catch {file delete -force -- tfa}

  1817     file mkdir tfa

  1818     file delete tfa

  1819     file exists tfa

  1820 } {0}

  1822 test fCmd-19.2 {rmdir error besides EEXIST} {unixOnly notRoot} {

  1823     catch {file delete -force -- tfa}

  1824     file mkdir tfa

  1825     file mkdir tfa/a

  1826     file attributes tfa -permissions 0555

  1827     set result [catch {file delete tfa/a}]

  1828     file attributes tfa -permissions 0777

  1829     file delete -force tfa

  1830     set result

  1831 } {1}

  1833 test fCmd-19.3 {recursive remove} {notRoot} {

  1834     catch {file delete -force -- tfa}

  1835     file mkdir tfa

  1836     file mkdir tfa/a

  1837     file delete -force tfa

  1838     file exists tfa

  1839 } {0}

  1841 #

  1842 # TclUnixDeleteFile and TraversalDelete are covered by tests from the

  1843 # TclDeleteFilesCmd suite

  1844 #

  1845 #

  1847 #

  1848 # Coverage tests for TraverseUnixTree(), called from TclDeleteFilesCmd

  1849 #

  1851 test fCmd-20.1 {TraverseUnixTree : failure opening a subdirectory directory } \

  1852 	{unixOnly notRoot} {

  1853     catch {file delete -force -- tfa}

  1854     file mkdir tfa

  1855     file mkdir tfa/a

  1856     file attributes tfa/a -permissions 0000

  1857     set result [catch {file delete -force tfa}]

  1858     file attributes tfa/a -permissions 0777

  1859     file delete -force tfa

  1860     set result

  1861 } {1}

  1863 test fCmd-20.2 {TraverseUnixTree : recursive delete of large directory: Bug 1034337} \

  1864 	{unix notRoot} {

  1865     catch {file delete -force -- tfa}

  1866     file mkdir tfa

  1867     for {set i 1} {$i <= 300} {incr i} {createfile tfa/testfile_$i}

  1868     set result [catch {file delete -force tfa} msg]

  1869     while {[catch {file delete -force tfa}]} {}

  1870     list $result $msg

  1871 } {0 {}}

  1873 #

  1874 # Feature testing for TclCopyFilesCmd

  1875 #

  1876 test fCmd-21.1 {copy : single file to nonexistant } {notRoot} {

  1877     catch {file delete -force -- tfa1 tfa2}

  1878     set s [createfile tfa1]

  1879     file copy tfa1 tfa2

  1880     set result [expr [checkcontent tfa2 $s] && [checkcontent tfa1 $s]]

  1881     file delete tfa1 tfa2

  1882     set result

  1883 } {1}

  1885 test fCmd-21.2 {copy : single dir to nonexistant } {notRoot} {

  1886     catch {file delete -force -- tfa1 tfa2}

  1887     file mkdir tfa1

  1888     file copy tfa1 tfa2

  1889     set result [expr [file isdir tfa2] && [file isdir tfa1]]

  1890     file delete tfa1 tfa2

  1891     set result

  1892 } {1}

  1894 test fCmd-21.3 {copy : single file into directory  } {notRoot} {

  1895     catch {file delete -force -- tfa1 tfad}

  1896     set s [createfile tfa1]

  1897     file mkdir tfad

  1898     file copy tfa1 tfad

  1899     set result [expr [checkcontent tfad/tfa1 $s] && [checkcontent tfa1 $s]]

  1900     file delete -force tfa1 tfad

  1901     set result

  1902 } {1}

  1904 test fCmd-21.4 {copy : more than one source and target is not a directory} \

  1905 	{notRoot} {

  1906     catch {file delete -force -- tfa1 tfa2 tfa3}

  1907     createfile tfa1

  1908     createfile tfa2

  1909     createfile tfa3

  1910     set result [catch {file copy tfa1 tfa2 tfa3}]

  1911     file delete tfa1 tfa2 tfa3

  1912     set result

  1913 } {1}

  1915 test fCmd-21.5 {copy : multiple files into directory  } {notRoot} {

  1916     catch {file delete -force -- tfa1 tfa2 tfad}

  1917     set s1 [createfile tfa1 ]

  1918     set s2 [createfile tfa2 ]

  1919     file mkdir tfad

  1920     file copy tfa1 tfa2 tfad

  1921     set r1 [checkcontent tfad/tfa1 $s1]

  1922     set r2 [checkcontent tfad/tfa2 $s2]

  1923     set r3 [checkcontent tfa1 $s1]

  1924     set r4 [checkcontent tfa2 $s2]

  1925     set result [expr $r1 && $r2 && $r3 && $r4]

  1926     file delete -force tfa1 tfa2 tfad

  1927     set result

  1928 } {1}

  1930 test fCmd-21.6 {copy: mixed dirs and files into directory} \

  1931 	{notRoot notFileSharing} {

  1932     catch {file delete -force -- tfa1 tfad1 tfad2}

  1933     set s [createfile tfa1 ]

  1934     file mkdir tfad1 tfad2

  1935     file copy tfa1 tfad1 tfad2

  1936     set r1 [checkcontent [file join tfad2 tfa1] $s]

  1937     set r2 [file isdir [file join tfad2 tfad1]]

  1938     set r3 [checkcontent tfa1 $s]

  1939     set result [expr $r1 && $r2 && $r3 && [file isdir tfad1]]

  1940     file delete -force tfa1 tfad1 tfad2

  1941     set result

  1942 } {1}

  1944 test fCmd-21.7.1 {TclCopyFilesCmd: copy a dangling link} {unixOnly notRoot dontCopyLinks} {

  1945     file mkdir tfad1

  1946     file link -symbolic tfalink tfad1

  1947     file delete tfad1

  1948     set result [list [catch {file copy tfalink tfalink2} msg] $msg]

  1949     file delete -force tfalink tfalink2

  1950     set result

  1951 } {1 {error copying "tfalink": the target of this link doesn't exist}}

  1952 test fCmd-21.7.2 {TclCopyFilesCmd: copy a dangling link} {unixOnly notRoot} {

  1953     file mkdir tfad1

  1954     file link -symbolic tfalink tfad1

  1955     file delete tfad1

  1956     file copy tfalink tfalink2

  1957     set result [string match [file type tfalink2] link]

  1958     file delete tfalink tfalink2

  1959     set result

  1960 } {1}

  1962 test fCmd-21.8.1 {TclCopyFilesCmd: copy a link } {unixOnly notRoot dontCopyLinks} {

  1963     file mkdir tfad1

  1964     file link -symbolic tfalink tfad1

  1965     file copy tfalink tfalink2

  1966     set r1 [file type tfalink]; # link

  1967     set r2 [file type tfalink2]; # directory

  1968     set r3 [file isdir tfad1]; # 1

  1969     set result [expr {("$r1" == "link") && ("$r2" == "directory") && $r3}]

  1970     file delete -force tfad1 tfalink tfalink2

  1971     set result

  1972 } {1}

  1973 test fCmd-21.8.2 {TclCopyFilesCmd: copy a link } {unixOnly notRoot} {

  1974     file mkdir tfad1

  1975     file link -symbolic tfalink tfad1

  1976     file copy tfalink tfalink2

  1977     set r1 [file type tfalink]; # link

  1978     set r2 [file type tfalink2]; # link

  1979     set r3 [file isdir tfad1]; # 1

  1980     set result [expr {("$r1" == "link") && ("$r2" == "link") && $r3}]

  1981     file delete -force tfad1 tfalink tfalink2

  1982     set result

  1983 } {1}

  1985 test fCmd-21.9 {TclCopyFilesCmd: copy dir with a link in it} {unixOnly notRoot} {

  1986     file mkdir tfad1

  1987     file link -symbolic tfad1/tfalink "[pwd]/tfad1"

  1988     file copy tfad1 tfad2

  1989     set result [string match [file type tfad2/tfalink] link]

  1990     file delete -force tfad1 tfad2

  1991     set result

  1992 } {1}

  1994 test fCmd-21.10 {TclFileCopyCmd: copy dir on top of another empty dir w/o -force} \

  1995 	{notRoot} {

  1996     catch {file delete -force -- tfa tfad}

  1997     file mkdir tfa [file join tfad tfa]

  1998     set r1 [catch {file copy tfa tfad}]

  1999     set result [expr $r1 && [file isdir tfa]]

  2000     file delete -force tfa tfad

  2001     set result

  2002 } {1}

  2004 test fCmd-21.11 {TclFileCopyCmd: copy dir on top of a dir w/o -force} {notRoot} {

  2005     catch {file delete -force -- tfa tfad}

  2006     file mkdir tfa [file join tfad tfa file]

  2007     set r1 [catch {file copy tfa tfad}]

  2008     set result [expr $r1 && [file isdir tfa] && [file isdir [file join tfad tfa file]]]

  2009     file delete -force tfa tfad

  2010     set result

  2011 } {1}

  2013 test fCmd-21.12 {TclFileCopyCmd: copy dir on top of a non-empty dir w/ -force} \

  2014 	{notRoot} {

  2015     catch {file delete -force -- tfa tfad}

  2016     file mkdir tfa [file join tfad tfa file]

  2017     set r1 [catch {file copy -force tfa tfad}]

  2018     set result [expr $r1 && [file isdir tfa] && [file isdir [file join tfad tfa file]]]

  2019     file delete -force tfa tfad

  2020     set result

  2021 } {1}

  2023 #

  2024 # Coverage testing for TclpRenameFile

  2025 #

  2026 test fCmd-22.1 {TclpRenameFile: rename and overwrite in a single dir} {notRoot} {

  2027     catch {file delete -force -- tfa1 tfa2}

  2028     set s [createfile tfa1]

  2029     set s2 [createfile tfa2 q]

  2031     set r1 [catch {rename tfa1 tfa2}]

  2032     file rename -force tfa1 tfa2

  2033     set result [expr $r1 && [checkcontent tfa2 $s]]

  2034     file delete [glob tfa1 tfa2]

  2035     set result

  2036 } {1}

  2038 test fCmd-22.2 {TclpRenameFile: attempt to overwrite itself} {macOrUnix notRoot} {

  2039     catch {file delete -force -- tfa1}

  2040     set s [createfile tfa1]

  2041     file rename -force tfa1 tfa1

  2042     set result [checkcontent tfa1 $s]

  2043     file delete tfa1

  2044     set result

  2045 } {1}

  2047 test fCmd-22.3 {TclpRenameFile: rename dir to existing dir} {notRoot} {

  2048     catch {file delete -force -- d1 tfad}

  2049     file mkdir d1 [file join tfad d1]

  2050     set r1 [catch {file rename d1 tfad}]

  2051     set result [expr $r1 && [file isdir d1] && [file isdir [file join tfad d1]]]

  2052     file delete -force d1 tfad

  2053     set result

  2054 } {1}

  2056 test fCmd-22.4 {TclpRenameFile: rename dir to dir several levels deep} {notRoot} {

  2057     catch {file delete -force -- d1 tfad}

  2058     file mkdir d1 [file join tfad a b c]

  2059     file rename d1 [file join tfad a b c d1]

  2060     set result [expr ![file isdir d1] && [file isdir [file join tfad a b c d1]]]

  2061     file delete -force [glob d1 tfad]

  2062     set result

  2063 } {1}

  2066 #

  2067 # TclMacCopyFile needs to be redone.

  2068 #

  2069 test fCmd-22.5 {TclMacCopyFile: copy and overwrite in a single dir} {notRoot} {

  2070     catch {file delete -force -- tfa1 tfa2}

  2071     set s [createfile tfa1]

  2072     set s2 [createfile tfa2 q]

  2074     set r1 [catch {file copy tfa1 tfa2}]

  2075     file copy -force tfa1 tfa2

  2076     set result [expr $r1 && [checkcontent tfa2 $s] && [checkcontent tfa1 $s]]

  2077     file delete tfa1 tfa2

  2078     set result

  2079 } {1}

  2081 #

  2082 # TclMacMkdir - basic cases are covered elsewhere.

  2083 # Error cases are not covered.

  2084 #

  2086 #

  2087 # TclMacRmdir

  2088 # Error cases are not covered.

  2089 #

  2091 test fCmd-23.1 {TclMacRmdir: trying to remove a nonempty directory} {notRoot} {

  2092     catch {file delete -force -- tfad}

  2094     file mkdir [file join tfad dir]

  2096     set result [catch {file delete tfad}]

  2097     file delete -force tfad

  2098     set result

  2099 } {1}

  2101 #

  2102 # TclMacDeleteFile

  2103 # Error cases are not covered.

  2104 #

  2105 test fCmd-24.1 {TclMacDeleteFile: deleting a normal file} {notRoot} {

  2106     catch {file delete -force -- tfa1}

  2108     createfile tfa1

  2109     file delete tfa1

  2110     file exists tfa1

  2111 } {0}

  2113 #

  2114 # TclMacCopyDirectory

  2115 # Error cases are not covered.

  2116 #

  2117 test fCmd-25.1 {TclMacCopyDirectory: copying a normal directory} {notRoot notFileSharing} {

  2118     catch {file delete -force -- tfad1 tfad2}

  2120     file mkdir [file join tfad1 a b c]

  2121     file copy tfad1 tfad2

  2122     set result [expr [file isdir [file join tfad1 a b c]] && [file isdir [file join tfad2 a b c]]]

  2123     file delete -force tfad1 tfad2

  2124     set result

  2125 } {1}

  2127 test fCmd-25.2 {TclMacCopyDirectory: copying a short path normal directory} {notRoot notFileSharing} {

  2128     catch {file delete -force -- tfad1 tfad2}

  2130     file mkdir tfad1

  2131     file copy tfad1 tfad2

  2132     set result [expr [file isdir tfad1] && [file isdir tfad2]]

  2133     file delete tfad1 tfad2

  2134     set result

  2135 } {1}

  2137 test fCmd-25.3 {TclMacCopyDirectory: copying dirs between different dirs} {notRoot notFileSharing} {

  2138     catch {file delete -force -- tfad1 tfad2}

  2140     file mkdir [file join tfad1 x y z]

  2141     file mkdir [file join tfad2 dir]

  2142     file copy tfad1 [file join tfad2 dir]

  2143     set result [expr [file isdir [file join tfad1 x y z]] && [file isdir [file join tfad2 dir tfad1 x y z]]]

  2144     file delete -force tfad1 tfad2

  2145     set result

  2146 } {1}

  2148 #

  2149 # Functionality tests for TclDeleteFilesCmd

  2150 #

  2152 test fCmd-26.1 {TclDeleteFilesCmd: delete symlink} {unixOnly notRoot} {

  2153     catch {file delete -force -- tfad1 tfad2}

  2155     file mkdir tfad1

  2156     file link -symbolic tfalink tfad1

  2157     file delete tfalink

  2159     set r1 [file isdir tfad1]

  2160     set r2 [file exists tfalink]

  2162     set result [expr $r1 && !$r2]

  2163     file delete tfad1

  2164     set result

  2165 } {1}

  2167 test fCmd-26.2 {TclDeleteFilesCmd: delete dir with symlink} {unixOnly notRoot} {

  2168     catch {file delete -force -- tfad1 tfad2}

  2170     file mkdir tfad1

  2171     file mkdir tfad2

  2172     file link -symbolic [file join tfad2 link] tfad1

  2173     file delete -force tfad2

  2175     set r1 [file isdir tfad1]

  2176     set r2 [file exists tfad2]

  2178     set result [expr $r1 && !$r2]

  2179     file delete tfad1

  2180     set result

  2181 } {1}

  2183 test fCmd-26.3 {TclDeleteFilesCmd: delete dangling symlink} {unixOnly notRoot} {

  2184     catch {file delete -force -- tfad1 tfad2}

  2186     file mkdir tfad1

  2187     file link -symbolic tfad2 tfad1

  2188     file delete tfad1

  2189     file delete tfad2

  2191     set r1 [file exists tfad1]

  2192     set r2 [file exists tfad2]

  2194     set result [expr !$r1 && !$r2]

  2195     set result

  2196 } {1}

  2198 test fCmd-27.2 {TclFileAttrsCmd - Tcl_TranslateFileName fails} {testsetplatform} {

  2199     set platform [testgetplatform]

  2200     testsetplatform unix

  2201     list [catch {file attributes ~_totally_bogus_user} msg] $msg [testsetplatform $platform]

  2202 } {1 {user "_totally_bogus_user" doesn't exist} {}}

  2203 test fCmd-27.3 {TclFileAttrsCmd - all attributes} {

  2204     catch {file delete -force -- foo.tmp}

  2205     createfile foo.tmp

  2206     list [catch {file attributes foo.tmp} msg] [expr {[llength $msg] > 0}] [file delete -force -- foo.tmp]

  2207 } {0 1 {}}

  2208 test fCmd-27.4 {TclFileAttrsCmd - getting one option} {

  2209     catch {file delete -force -- foo.tmp}

  2210     createfile foo.tmp

  2211     set attrs [file attributes foo.tmp]

  2212     list [catch {eval file attributes foo.tmp [lindex $attrs 0]}] [file delete -force -- foo.tmp]

  2213 } {0 {}}

  2215 # Find a group that exists on this Unix system, or else skip tests that

  2216 # require Unix groups.

  2217 if {$tcl_platform(platform) == "unix"} {

  2218     ::tcltest::testConstraint foundGroup 0

  2219     catch {

  2220 	set groupList [exec groups]

  2221 	set group [lindex $groupList 0]

  2222 	::tcltest::testConstraint foundGroup 1

  2223     }

  2224 } else {

  2225     ::tcltest::testConstraint foundGroup 1

  2226 }

  2228 test fCmd-27.5 {TclFileAttrsCmd - setting one option} {foundGroup} {

  2229     catch {file delete -force -- foo.tmp}

  2230     createfile foo.tmp

  2231     set attrs [file attributes foo.tmp]

  2232     list [catch {eval file attributes foo.tmp [lrange $attrs 0 1]} msg] $msg [file delete -force -- foo.tmp]

  2233 } {0 {} {}}

  2234 test fCmd-27.6 {TclFileAttrsCmd - setting more than one option} {foundGroup} {

  2235     catch {file delete -force -- foo.tmp}

  2236     createfile foo.tmp

  2237     set attrs [file attributes foo.tmp]

  2238     list [catch {eval file attributes foo.tmp [lrange $attrs 0 3]} msg] $msg [file delete -force -- foo.tmp]

  2239 } {0 {} {}}

  2241 if {[string equal $tcl_platform(platform) "windows"]} {

  2242     if {[string index $tcl_platform(osVersion) 0] >= 5 \

  2243       && ([lindex [file system [temporaryDirectory]] 1] == "NTFS")} {

  2244 	tcltest::testConstraint linkDirectory 1

  2245 	tcltest::testConstraint linkFile 1

  2246     } else {

  2247 	tcltest::testConstraint linkDirectory 0

  2248 	tcltest::testConstraint linkFile 0

  2249     }

  2250 } else {

  2251     tcltest::testConstraint linkFile 1

  2252     tcltest::testConstraint linkDirectory 1

  2254     if {[string equal $tcl_platform(osSystemName) "Symbian"]} {

  2255        tcltest::testConstraint linkDirectory 0

  2256     }

  2257 }

  2259 test fCmd-28.1 {file link} {

  2260     list [catch {file link} msg] $msg

  2261 } {1 {wrong # args: should be "file link ?-linktype? linkname ?target?"}}

  2263 test fCmd-28.2 {file link} {

  2264     list [catch {file link a b c d} msg] $msg

  2265 } {1 {wrong # args: should be "file link ?-linktype? linkname ?target?"}}

  2267 test fCmd-28.3 {file link} {

  2268     list [catch {file link abc b c} msg] $msg

  2269 } {1 {bad switch "abc": must be -symbolic or -hard}}

  2271 test fCmd-28.4 {file link} {

  2272     list [catch {file link -abc b c} msg] $msg

  2273 } {1 {bad switch "-abc": must be -symbolic or -hard}}

  2274 cd [workingDirectory]

  2276 makeDirectory abc.dir

  2277 makeDirectory abc2.dir

  2278 makeFile contents abc.file

  2279 makeFile contents abc2.file

  2281 cd [temporaryDirectory]

  2282 test fCmd-28.5 {file link: source already exists} {linkDirectory} {

  2283     cd [temporaryDirectory]

  2284     set res [list [catch {file link abc.dir abc2.dir} msg] $msg]

  2285     cd [workingDirectory]

  2286     set res

  2287 } {1 {could not create new link "abc.dir": that path already exists}}

  2289 test fCmd-28.6 {file link: unsupported operation} {linkDirectory macOrWin} {

  2290     cd [temporaryDirectory]

  2291     set res [list [catch {file link -hard abc.link abc.dir} msg] $msg]

  2292     cd [workingDirectory]

  2293     set res

  2294 } {1 {could not create new link "abc.link" pointing to "abc.dir": illegal operation on a directory}}

  2296 test fCmd-28.7 {file link: source already exists} {linkFile} {

  2297     cd [temporaryDirectory]

  2298     set res [list [catch {file link abc.file abc2.file} msg] $msg]

  2299     cd [workingDirectory]

  2300     set res

  2301 } {1 {could not create new link "abc.file": that path already exists}}

  2303 test fCmd-28.8 {file link} {linkFile winOnly} {

  2304     cd [temporaryDirectory]

  2305     set res [list [catch {file link -symbolic abc.link abc.file} msg] $msg]

  2306     cd [workingDirectory]

  2307     set res

  2308 } {1 {could not create new link "abc.link" pointing to "abc.file": not a directory}}

  2310 test fCmd-28.9 {file link: success with file} {linkFile} {

  2311     cd [temporaryDirectory]

  2312     file delete -force abc.link

  2313     set res [list [catch {file link abc.link abc.file} msg] $msg]

  2314     cd [workingDirectory]

  2315     set res

  2316 } {0 abc.file}

  2318 cd [temporaryDirectory]

  2319 catch {file delete -force abc.link}

  2320 cd [workingDirectory]

  2322 test fCmd-28.10 {file link: linking to nonexistent path} {linkDirectory} {

  2323     cd [temporaryDirectory]

  2324     file delete -force abc.link

  2325     set res [list [catch {file link abc.link abc2.doesnt} msg] $msg]

  2326     cd [workingDirectory]

  2327     set res

  2328 } {1 {could not create new link "abc.link" since target "abc2.doesnt" doesn't exist}}

  2330 test fCmd-28.11 {file link: success with directory} {linkDirectory} {

  2331     cd [temporaryDirectory]

  2332     file delete -force abc.link

  2333     set res [list [catch {file link abc.link abc.dir} msg] $msg]

  2334     cd [workingDirectory]

  2335     set res

  2336 } {0 abc.dir}

  2338 test fCmd-28.12 {file link: cd into a link} {linkDirectory} {

  2339     cd [temporaryDirectory]

  2340     file delete -force abc.link

  2341     file link abc.link abc.dir

  2342     set orig [pwd]

  2343     cd abc.link

  2344     set dir [pwd]

  2345     cd ..

  2346     set up [pwd]

  2347     cd $orig

  2348     # now '$up' should be either $orig or [file dirname abc.dir],

  2349     # depending on whether 'cd' actually moves to the destination

  2350     # of a link, or simply treats the link as a directory.

  2351     # (on windows the former, on unix the latter, I believe)

  2352     if {([file normalize $up] != [file normalize $orig]) \

  2353       && ([file normalize $up] != [file normalize [file dirname abc.dir]])} {

  2354 	set res "wrong directory with 'cd $link ; cd ..'"

  2355     } else {

  2356 	set res "ok"

  2357     }

  2358     cd [workingDirectory]

  2359     set res

  2360 } {ok}

  2362 test fCmd-28.13 {file link} {linkDirectory} {

  2363     # duplicate link throws error

  2364     cd [temporaryDirectory]

  2365     set res [list [catch {file link abc.link abc.dir} msg] $msg]

  2366     cd [workingDirectory]

  2367     set res

  2368 } {1 {could not create new link "abc.link": that path already exists}}

  2370 test fCmd-28.14 {file link: deletes link not dir} {linkDirectory} {

  2371     cd [temporaryDirectory]

  2372     file delete -force abc.link

  2373     set res [list [file exists abc.link] [file exists abc.dir]]

  2374     cd [workingDirectory]

  2375     set res

  2376 } {0 1}

  2378 test fCmd-28.15.1 {file link: copies link not dir} {linkDirectory dontCopyLinks} {

  2379     cd [temporaryDirectory]

  2380     file delete -force abc.link

  2381     file link abc.link abc.dir

  2382     file copy abc.link abc2.link

  2383     # abc2.linkdir was a copy of a link to a dir, so it should end up as

  2384     # a directory, not a link (links trace to endpoint).

  2385     set res [list [file type abc2.link] [file tail [file link abc.link]]]

  2386     cd [workingDirectory]

  2387     set res

  2388 } {directory abc.dir}

  2389 test fCmd-28.15.2 {file link: copies link not dir} {linkDirectory} {

  2390     cd [temporaryDirectory]

  2391     file delete -force abc.link

  2392     file link abc.link abc.dir

  2393     file copy abc.link abc2.link

  2394     set res [list [file type abc2.link] [file tail [file link abc2.link]]]

  2395     cd [workingDirectory]

  2396     set res

  2397 } {link abc.dir}

  2399 cd [temporaryDirectory]

  2400 file delete -force abc.link

  2401 file delete -force abc2.link

  2403 file copy abc.file abc.dir

  2404 file copy abc2.file abc.dir

  2405 cd [workingDirectory]

  2407 test fCmd-28.16 {file link: glob inside link} {linkDirectory} {

  2408     cd [temporaryDirectory]

  2409     file delete -force abc.link

  2410     file link abc.link abc.dir

  2411     set res [lsort [glob -dir abc.link -tails *]]

  2412     cd [workingDirectory]

  2413     set res

  2414 } [lsort [list abc.file abc2.file]]

  2416 test fCmd-28.17 {file link: glob -type l} {linkDirectory} {

  2417     cd [temporaryDirectory]

  2418     set res [glob -dir [pwd] -type l -tails abc*]

  2419     cd [workingDirectory]

  2420     set res

  2421 } {abc.link}

  2423 test fCmd-28.18 {file link: glob -type d} {linkDirectory} {

  2424     cd [temporaryDirectory]

  2425     set res [lsort [glob -dir [pwd] -type d -tails abc*]]

  2426     cd [workingDirectory]

  2427     set res

  2428 } [lsort [list abc.link abc.dir abc2.dir]]

  2430 test fCmd-29.1 {weird memory corruption fault} {

  2431     catch {set res [open [file join ~a_totally_bogus_user_id/foo bar]]}

  2432 } 1

  2434 cd [temporaryDirectory]

  2435 file delete -force abc.link

  2436 cd [workingDirectory]

  2438 removeFile abc2.file

  2439 removeFile abc.file

  2440 removeDirectory abc2.dir

  2441 removeDirectory abc.dir

  2443 # cleanup

  2444 cleanup

  2445 ::tcltest::cleanupTests

  2446 return

author	sl@SLION-WIN7.fritz.box
	Fri, 15 Jun 2012 03:10:57 +0200
changeset 0	bde4ae8d615e
permissions	-rw-r--r--