285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
|
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
|
-
+
+
+
+
+
+
+
|
test filesystem-1.32 {link normalisation: link near filesystem root} {testsetplatform} {
testsetplatform unix
file normalize /../bar
} {/bar}
test filesystem-1.33 {link normalisation: link near filesystem root} {testsetplatform} {
testsetplatform windows
file normalize C:/../bar
set res [file normalize C:/../bar]
if {$::tcl_platform(platform) == "unix"} {
# Some unices go further in normalizing this -- not really
# a problem since this is a Windows test
regexp {C:/bar$} $res res
}
set res
} {C:/bar}
if {[tcltest::testConstraint testsetplatform]} {
testsetplatform $platform
}
test filesystem-1.34 {file normalisation with '/./'} {
|
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
|
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
|
-
+
+
+
+
|
set fout [open [file join simpledir simplefile] w]
puts -nonewline $fout "1234567890"
close $fout
testsimplefilesystem 1
# First copy should succeed
set res [catch {file copy simplefs:/simpledir dir2} err]
lappend res $err
file attributes file2 -permissions 0000
file attributes dir2 -permissions 0000
# Second copy should fail (no -force)
lappend res [catch {file copy simplefs:/simpledir dir2} err]
lappend res $err
# Third copy should succeed (-force)
# I've noticed on some Unices that this only succeeds
# intermittently (some runs work, some fail). This needs
# examining further.
lappend res [catch {file copy -force simplefs:/simpledir dir2} err]
lappend res $err
lappend res [file exists [file join dir2 simpledir]] \
[file exists [file join dir2 simpledir simplefile]]
testsimplefilesystem 0
file delete -force simpledir
file delete -force dir2
|