OpenCores
URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tcl/] [tests/] [fCmd.test] - Blame information for rev 1765

Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.