fcmd.test

tcl是工具命令语言

    set r1 [catch {file rename tfad tfa}]
    set r2 [checkcontent tfa $s]
    set r3 [file isdir tfad]
    set result [expr $r1 && $r2 && $r3 ]
    file delete tfa tfad
    set result
} {1}

test fCmd-18.5 {TclFileRenameCmd: attempt to replace dir with non-dir} {notRoot} {
    catch {file delete -force -- tfa tfad}
    set s [createfile tfa ]
    file mkdir tfad/tfa
    set r1 [catch {file rename tfa tfad}]
    set r2 [checkcontent tfa $s]
    set r3 [file isdir tfad/tfa]
    set result [expr $r1 && $r2 && $r3 ]
    file delete -force  tfa tfad
    set result
} {1}

#
# On Windows there is no easy way to determine if two files are the same
#
test fCmd-18.6 {TclFileRenameCmd: rename a file to itself} {macOrUnix notRoot} {
    catch {file delete -force -- tfa}
    set s [createfile tfa]
    set r1 [catch {file rename tfa tfa}]
    set result [expr $r1 && [checkcontent tfa $s]]
    file delete tfa
    set result
} {1}

test fCmd-18.7 {TclFileRenameCmd: rename dir on top of another empty dir w/o -force} \
	{notRoot} {
    catch {file delete -force -- tfa tfad}
    file mkdir tfa tfad/tfa
    set r1 [catch {file rename tfa tfad}]
    set result [expr $r1 && [file isdir tfa]]
    file delete -force tfa tfad
    set result
} {1}

test fCmd-18.8 {TclFileRenameCmd: rename dir on top of another empty dir w/ -force} \
	{notRoot} {
    catch {file delete -force -- tfa tfad}
    file mkdir tfa tfad/tfa
    file rename -force tfa tfad
    set result [expr ![file isdir tfa]]
    file delete -force tfad
    set result
} {1}

test fCmd-18.9 {TclFileRenameCmd: rename dir on top of a non-empty dir w/o -force} \
	{notRoot} {
    catch {file delete -force -- tfa tfad}
    file mkdir tfa tfad/tfa/file
    set r1 [catch {file rename tfa tfad}]
    set result [expr $r1 && [file isdir tfa] && [file isdir tfad/tfa/file]]
    file delete -force tfa tfad
    set result
} {1}

test fCmd-18.10 {TclFileRenameCmd: rename dir on top of a non-empty dir w/ -force} \
	{notRoot} {
    catch {file delete -force -- tfa tfad}
    file mkdir tfa tfad/tfa/file
    set r1 [catch {file rename -force tfa tfad}]
    set result [expr $r1 && [file isdir tfa] && [file isdir tfad/tfa/file]]
    file delete -force tfa tfad
    set result
} {1}

test fCmd-18.11 {TclFileRenameCmd: rename a non-existant file} {notRoot} {
    catch {file delete -force -- tfa1}
    set r1 [catch {file rename tfa1 tfa2}]
    set result [expr $r1 && ![file exists tfa1] && ![file exists tfa2]]
} {1}

test fCmd-18.12 {TclFileRenameCmd : rename a symbolic link to file} \
	{unixOnly notRoot} {
    catch {file delete -force -- tfa1 tfa2 tfa3}
	
    set s [createfile tfa1]
    file link -symbolic tfa2 tfa1
    file rename tfa2 tfa3
    set t [file type tfa3]
    set result [expr {$t eq "link"}]
    file delete tfa1 tfa3
    set result
} {1}

test fCmd-18.13 {TclFileRenameCmd : rename a symbolic link to dir} \
	{unixOnly notRoot} {
    catch {file delete -force -- tfa1 tfa2 tfa3}
	
    file mkdir tfa1
    file link -symbolic tfa2 tfa1
    file rename tfa2 tfa3
    set t [file type tfa3]
    set result [expr {$t eq "link"}]
    file delete tfa1 tfa3
    set result
} {1}

test fCmd-18.14 {TclFileRenameCmd : rename a path with sym link} \
	{unixOnly notRoot} {
    catch {file delete -force -- tfa1 tfa2 tfa3}
	
    file mkdir tfa1/a/b/c/d
    file mkdir tfa2
    set f [file join [pwd] tfa1/a/b] 
    set f2 [file join [pwd] {tfa2/b alias}]
    file link -symbolic $f2 $f
    file rename {tfa2/b alias/c} tfa3
    set r1 [file isdir tfa3]
    set r2 [file exists tfa1/a/b/c]
    set result [expr $r1 && !$r2]
    file delete -force tfa1 tfa2 tfa3
    set result
} {1}

test fCmd-18.15 {TclFileRenameCmd : rename a file to a symlink dir} \
	{unixOnly notRoot} {
    catch {file delete -force -- tfa1 tfa2 tfalink}
	
    file mkdir tfa1
    set s [createfile tfa2]
    file link -symbolic tfalink tfa1

    file rename tfa2 tfalink
    set result [checkcontent tfa1/tfa2 $s ]
    file delete -force tfa1 tfalink
    set result
} {1}

test fCmd-18.16 {TclFileRenameCmd: rename a dangling symlink} {unixOnly notRoot} {
    catch {file delete -force -- tfa1 tfalink}
	
    file mkdir tfa1
    file link -symbolic tfalink tfa1
    file delete tfa1 
    file rename tfalink tfa2
    set result [expr [string compare [file type tfa2] "link"] == 0]
    file delete tfa2
    set result
} {1}


#
# Coverage tests for TclUnixRmdir
#
test fCmd-19.1 {remove empty directory} {notRoot} {
    catch {file delete -force -- tfa}
    file mkdir tfa
    file delete tfa
    file exists tfa
} {0}

test fCmd-19.2 {rmdir error besides EEXIST} {unixOnly notRoot} {
    catch {file delete -force -- tfa}
    file mkdir tfa
    file mkdir tfa/a
    file attributes tfa -permissions 0555
    set result [catch {file delete tfa/a}]
    file attributes tfa -permissions 0777
    file delete -force tfa
    set result
} {1}

test fCmd-19.3 {recursive remove} {notRoot} {
    catch {file delete -force -- tfa}
    file mkdir tfa
    file mkdir tfa/a
    file delete -force tfa
    file exists tfa
} {0}

#
# TclUnixDeleteFile and TraversalDelete are covered by tests from the 
# TclDeleteFilesCmd suite
#
#

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

test fCmd-20.1 {TraverseUnixTree : failure opening a subdirectory directory } \
	{unixOnly notRoot} {
    catch {file delete -force -- tfa}
    file mkdir tfa
    file mkdir tfa/a
    file attributes tfa/a -permissions 0000
    set result [catch {file delete -force tfa}]
    file attributes tfa/a -permissions 0777
    file delete -force tfa
    set result
} {1}


#
# Feature testing for TclCopyFilesCmd
# 
test fCmd-21.1 {copy : single file to nonexistant } {notRoot} {
    catch {file delete -force -- tfa1 tfa2}
    set s [createfile tfa1]
    file copy tfa1 tfa2
    set result [expr [checkcontent tfa2 $s] && [checkcontent tfa1 $s]]
    file delete tfa1 tfa2
    set result
} {1}

test fCmd-21.2 {copy : single dir to nonexistant } {notRoot} {
    catch {file delete -force -- tfa1 tfa2}
    file mkdir tfa1
    file copy tfa1 tfa2
    set result [expr [file isdir tfa2] && [file isdir tfa1]]
    file delete tfa1 tfa2
    set result
} {1}

test fCmd-21.3 {copy : single file into directory  } {notRoot} {
    catch {file delete -force -- tfa1 tfad}
    set s [createfile tfa1]
    file mkdir tfad
    file copy tfa1 tfad
    set result [expr [checkcontent tfad/tfa1 $s] && [checkcontent tfa1 $s]]
    file delete -force tfa1 tfad
    set result
} {1}

test fCmd-21.4 {copy : more than one source and target is not a directory} \
	{notRoot} {
    catch {file delete -force -- tfa1 tfa2 tfa3}
    createfile tfa1 
    createfile tfa2 
    createfile tfa3 
    set result [catch {file copy tfa1 tfa2 tfa3}]
    file delete tfa1 tfa2 tfa3
    set result
} {1}

test fCmd-21.5 {copy : multiple files into directory  } {notRoot} {
    catch {file delete -force -- tfa1 tfa2 tfad}
    set s1 [createfile tfa1 ]
    set s2 [createfile tfa2 ]
    file mkdir tfad
    file copy tfa1 tfa2 tfad
    set r1 [checkcontent tfad/tfa1 $s1]
    set r2 [checkcontent tfad/tfa2 $s2]
    set r3 [checkcontent tfa1 $s1]
    set r4 [checkcontent tfa2 $s2]
    set result [expr $r1 && $r2 && $r3 && $r4]
    file delete -force tfa1 tfa2 tfad
    set result
} {1}

test fCmd-21.6 {copy: mixed dirs and files into directory} \
	{notRoot notFileSharing} {
    catch {file delete -force -- tfa1 tfad1 tfad2}
    set s [createfile tfa1 ]
    file mkdir tfad1 tfad2
    file copy tfa1 tfad1 tfad2
    set r1 [checkcontent [file join tfad2 tfa1] $s]
    set r2 [file isdir [file join tfad2 tfad1]]
    set r3 [checkcontent tfa1 $s]
    set result [expr $r1 && $r2 && $r3 && [file isdir tfad1]]
    file delete -force tfa1 tfad1 tfad2
    set result
} {1}

test fCmd-21.7.1 {TclCopyFilesCmd: copy a dangling link} {unixOnly notRoot dontCopyLinks} {
    file mkdir tfad1
    file link -symbolic tfalink tfad1
    file delete tfad1
    set result [list [catch {file copy tfalink tfalink2} msg] $msg]
    file delete -force tfalink tfalink2 
    set result
} {1 {error copying "tfalink": the target of this link doesn't exist}}
test fCmd-21.7.2 {TclCopyFilesCmd: copy a dangling link} {unixOnly notRoot} {
    file mkdir tfad1
    file link -symbolic tfalink tfad1
    file delete tfad1
    file copy tfalink tfalink2
    set result [string match [file type tfalink2] link]
    file delete tfalink tfalink2 
    set result
} {1}

test fCmd-21.8.1 {TclCopyFilesCmd: copy a link } {unixOnly notRoot dontCopyLinks} {
    file mkdir tfad1
    file link -symbolic tfalink tfad1
    file copy tfalink tfalink2
    set r1 [file type tfalink]; # link
    set r2 [file type tfalink2]; # directory
    set r3 [file isdir tfad1]; # 1
    set result [expr {("$r1" == "link") && ("$r2" == "directory") && $r3}]
    file delete -force tfad1 tfalink tfalink2
    set result
} {1}
test fCmd-21.8.2 {TclCopyFilesCmd: copy a link } {unixOnly notRoot} {
    file mkdir tfad1
    file link -symbolic tfalink tfad1
    file copy tfalink tfalink2
    set r1 [file type tfalink]; # link
    set r2 [file type tfalink2]; # link
    set r3 [file isdir tfad1]; # 1
    set result [expr {("$r1" == "link") && ("$r2" == "link") && $r3}]
    file delete -force tfad1 tfalink tfalink2
    set result
} {1}

test fCmd-21.9 {TclCopyFilesCmd: copy dir with a link in it} {unixOnly notRoot} {
    file mkdir tfad1
    file link -symbolic tfad1/tfalink "[pwd]/tfad1"
    file copy tfad1 tfad2
    set result [string match [file type tfad2/tfalink] link]
    file delete -force tfad1 tfad2
    set result
} {1}

test fCmd-21.10 {TclFileCopyCmd: copy dir on top of another empty dir w/o -force} \
	{notRoot} {
    catch {file delete -force -- tfa tfad}
    file mkdir tfa [file join tfad tfa]
    set r1 [catch {file copy tfa tfad}]
    set result [expr $r1 && [file isdir tfa]]
    file delete -force tfa tfad
    set result
} {1}

test fCmd-21.11 {TclFileCopyCmd: copy dir on top of a dir w/o -force} {notRoot} {
    catch {file delete -force -- tfa tfad}
    file mkdir tfa [file join tfad tfa file]
    set r1 [catch {file copy tfa tfad}]
    set result [expr $r1 && [file isdir tfa] && [file isdir [file join tfad tfa file]]]
    file delete -force tfa tfad
    set result
} {1}

test fCmd-21.12 {TclFileCopyCmd: copy dir on top of a non-empty dir w/ -force} \
	{notRoot} {
    catch {file delete -force -- tfa tfad}
    file mkdir tfa [file join tfad tfa file]
    set r1 [catch {file copy -force tfa tfad}]
    set result [expr $r1 && [file isdir tfa] && [file isdir [file join tfad tfa file]]]
    file delete -force tfa tfad
    set result
} {1}

#
# Coverage testing for TclpRenameFile
#
test fCmd-22.1 {TclpRenameFile: rename and overwrite in a single dir} {notRoot} {
    catch {file delete -force -- tfa1 tfa2}
    set s [createfile tfa1]
    set s2 [createfile tfa2 q]
	
    set r1 [catch {rename tfa1 tfa2}]
    file rename -force tfa1 tfa2
    set result [expr $r1 && [checkcontent tfa2 $s]]
    file delete [glob tfa1 tfa2]
    set result
} {1}

test fCmd-22.2 {TclpRenameFile: attempt to overwrite itself} {macOrUnix notRoot} {
    catch {file delete -force -- tfa1}
    set s [createfile tfa1]	
    file rename -force tfa1 tfa1
    set result [checkcontent tfa1 $s]
    file delete tfa1 
    set result
} {1}

test fCmd-22.3 {TclpRenameFile: rename dir to existing dir} {notRoot} {
    catch {file delete -force -- d1 tfad}
    file mkdir d1 [file join tfad d1]
    set r1 [catch {file rename d1 tfad}]
    set result [expr $r1 && [file isdir d1] && [file isdir [file join tfad d1]]]
    file delete -force d1 tfad
    set result
} {1}

test fCmd-22.4 {TclpRenameFile: rename dir to dir several levels deep} {notRoot} {
    catch {file delete -force -- d1 tfad}
    file mkdir d1 [file join tfad a b c]
    file rename d1 [file join tfad a b c d1]
    set result [expr ![file isdir d1] && [file isdir [file join tfad a b c d1]]]
    file delete -force [glob d1 tfad]
    set result
} {1}


#
# TclMacCopyFile needs to be redone.
#
test fCmd-22.5 {TclMacCopyFile: copy and overwrite in a single dir} {notRoot} {
    catch {file delete -force -- tfa1 tfa2}
    set s [createfile tfa1]
    set s2 [createfile tfa2 q]

    set r1 [catch {file copy tfa1 tfa2}]
    file copy -force tfa1 tfa2
    set result [expr $r1 && [checkcontent tfa2 $s] && [checkcontent