fcmd.test

tcl是工具命令语言

    set r1 [catch {file copy -x tfa1 tfa2}]
    set result [expr $r1 && [checkcontent tfa1 $s] && ![file exists tfa2]]
    file delete tfa1
    set result
} {1}

test fCmd-13.4 {TclCopyFilesCmd: bad \# args} {notRoot} {
    catch {file copy -- }
} {1}

test fCmd-13.5 {TclCopyFilesCmd: target filename translation failing} {
     global env
     set temp $env(HOME)
    unset env(HOME)
     set result [catch {file copy tfa ~/foobar }]
     set env(HOME) $temp
     set result
 } {1}

test fCmd-13.6 {TclCopyFilesCmd: > 1 source & target is not a dir} {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-13.7 {TclCopyFilesCmd: 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 tfad tfa1
    set result
} {1}

test fCmd-13.8 {TclCopyFilesCmd: 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 tfad tfa1 tfa2
    set result
} {1}

test fCmd-13.9 {TclCopyFilesCmd: error copying file to directory} {notRoot} {
    catch {file delete -force -- tfa tfad}
    set s [createfile tfa ]
    file mkdir tfad
    file mkdir tfad/tfa
    set r1 [catch {file copy tfa tfad}]
    set r2 [expr [checkcontent tfa $s] && [file isdir tfad/tfa]]
    set r3 [file isdir tfad]
    set result [expr $r1 && $r2 && $r3 ]
    file delete -force tfa tfad
    set result
} {1}

#
# Coverage tests for copyfile()
# 
test fCmd-14.1 {copyfile: source filename translation failing} {notRoot} {
    global env
    set temp $env(HOME)
    unset env(HOME)
    set result [catch {file copy ~/tfa1 tfa2}]
    set env(HOME) $temp
    set result
} {1}

test fCmd-14.2 {copyfile: dst filename translation failing} {notRoot} {
    global env
    set temp $env(HOME)
    unset env(HOME)
    set s [createfile tfa1]
    file mkdir tfad
    set r1 [catch {file copy tfa1 ~/tfa2 tfad}]
    set result [expr $r1 && [checkcontent tfad/tfa1 $s]]
    set env(HOME) $temp
    file delete -force tfa1 tfad
    set result
} {1}

test fCmd-14.3 {copyfile: stat failing on source} {notRoot} {
    catch {file delete -force -- tfa1 tfa2}
    set r1 [catch {file copy tfa1 tfa2}]
    expr $r1 && ![file exists tfa1] && ![file exists tfa2]
} {1}

test fCmd-14.4 {copyfile: error copying file to directory} {notRoot} {
    catch {file delete -force -- tfa tfad}
    set s1 [createfile tfa ]
    file mkdir tfad
    file mkdir tfad/tfa
    set r1 [catch {file copy tfa tfad}]
    set r2 [checkcontent tfa $s1]
    set r3 [file isdir tfad]
    set r4 [file isdir tfad/tfa]
    set result [expr $r1 && $r2 && $r3 && $r4 ]
    file delete -force tfa tfad
    set result
} {1}

 test fCmd-14.5 {copyfile: error copying directory to file} {notRoot} {
     catch {file delete -force -- tfa tfad}
     file mkdir tfa
     file mkdir tfad
     set s [createfile tfad/tfa]
     set r1 [catch {file copy tfa tfad}]
     set r2 [checkcontent tfad/tfa $s]
     set r3 [file isdir tfad]
     set r4 [file isdir tfa]
     set result [expr $r1 && $r2 && $r3 && $r4 ]
     file delete -force tfa tfad
     set result
} {1}

test fCmd-14.6 {copyfile: copy file succeeding} {notRoot} {
    catch {file delete -force -- tfa tfa2}
    set s [createfile tfa]
    file copy tfa tfa2
    set result [expr  [checkcontent tfa $s] && [checkcontent tfa2 $s]]
    file delete tfa tfa2
    set result
} {1}

test fCmd-14.7 {copyfile: copy directory succeeding} {notRoot} {
    catch {file delete -force -- tfa tfa2}
    file mkdir tfa
    set s [createfile tfa/file]
    file copy tfa tfa2
    set result [expr [checkcontent tfa/file $s] && [checkcontent tfa2/file $s]]
    file delete -force tfa tfa2
    set result
} {1}

test fCmd-14.8 {copyfile: copy directory failing} {unixOnly notRoot} {
    catch {file delete -force -- tfa}
    file mkdir tfa/dir/a/b/c
    file attributes tfa/dir -permissions 0000
    set r1 [catch {file copy tfa tfa2}]
    file attributes tfa/dir -permissions 0777
    set result $r1
    file delete -force tfa tfa2
    set result
} {1}

#
# Coverage tests for TclMkdirCmd()
#
test fCmd-15.1 {TclMakeDirsCmd: target filename translation failing} {notRoot} {
    global env
    set temp $env(HOME)
    unset env(HOME) 
    set result [catch {file mkdir ~/tfa}]
    set env(HOME) $temp
    set result
} {1}
#
# Can Tcl_SplitPath return argc == 0? If so them we need a
# test for that code.
#
test fCmd-15.2 {TclMakeDirsCmd - one directory } {notRoot} {
    catch {file delete -force -- tfa}
    file mkdir tfa
    set result [file isdirectory tfa]
    file delete tfa
    set result
} {1}

test fCmd-15.3 {TclMakeDirsCmd: - two directories} {notRoot} {
    catch {file delete -force -- tfa1 tfa2}
    file mkdir tfa1 tfa2
    set result [expr [file isdirectory tfa1] && [file isdirectory tfa2]]
    file delete tfa1 tfa2
    set result
} {1}

test fCmd-15.4 {TclMakeDirsCmd - stat failing} {unixOnly notRoot} {
    catch {file delete -force -- tfa}
    file mkdir tfa
    createfile tfa/file
    file attributes tfa -permissions 0000
    set result [catch {file mkdir tfa/file}]
    file attributes tfa -permissions 0777
    file delete -force tfa
    set result
} {1}

test fCmd-15.5 {TclMakeDirsCmd: - making a directory several levels deep} \
	{notRoot} {
    catch {file delete -force -- tfa}
    file mkdir tfa/a/b/c
    set result [file isdir tfa/a/b/c]
    file delete -force tfa
    set result
} {1}

    
test fCmd-15.6 {TclMakeDirsCmd: - trying to overwrite a file} {notRoot} {
    catch {file delete -force -- tfa}
    set s [createfile tfa]
    set r1 [catch {file mkdir tfa}]
    set r2 [file isdir tfa]
    set r3 [file exists tfa]
    set result [expr $r1 && !$r2 && $r3 && [checkcontent tfa $s]]
    file delete tfa
    set result
} {1}

test fCmd-15.7 {TclMakeDirsCmd - making several directories} {notRoot} {
    catch {file delete -force -- tfa1 tfa2}
    file mkdir tfa1 tfa2/a/b/c
    set result [expr [file isdir tfa1] && [file isdir tfa2/a/b/c]]
    file delete -force tfa1 tfa2
    set result
} {1}

test fCmd-15.8 {TclFileMakeDirsCmd: trying to create an existing dir} {notRoot} {
    file mkdir tfa
    file mkdir tfa
    set result [file isdir tfa]
    file delete tfa
    set result
} {1}


# Coverage tests for TclDeleteFilesCommand()
test fCmd-16.1 {test the -- argument} {notRoot} {
    catch {file delete -force -- tfa}
    createfile tfa
    file delete -- tfa
    file exists tfa
} {0}

test fCmd-16.2 {test the -force and -- arguments} {notRoot} {
    catch {file delete -force -- tfa}
    createfile tfa
    file delete -force -- tfa
    file exists tfa
} {0}

test fCmd-16.3 {test bad option} {notRoot} {
    catch {file delete -force -- tfa}
    createfile tfa
    set result [catch {file delete -dog tfa}]
    file delete tfa
    set result
} {1}

test fCmd-16.4 {test not enough args} {notRoot} {
    catch {file delete}
} {1}

test fCmd-16.5 {test not enough args with options} {notRoot} {
    catch {file delete --}
} {1}

test fCmd-16.6 {delete: source filename translation failing} {notRoot} {
    global env
    set temp $env(HOME)
    unset env(HOME)
    set result [catch {file delete ~/tfa}]
    set env(HOME) $temp
    set result
} {1}

test fCmd-16.7 {remove a non-empty directory without -force } {notRoot} {
    catch {file delete -force -- tfa}
    file mkdir tfa
    createfile tfa/a
    set result [catch  {file delete tfa }]
    file delete -force tfa
    set result
} {1}

test fCmd-16.8 {remove a normal file } {notRoot} {
    catch {file delete -force -- tfa}
    file mkdir tfa
    createfile tfa/a
    set result [catch  {file delete tfa }]
    file delete -force tfa
    set result
} {1}

test fCmd-16.9 {error while deleting file } {unixOnly notRoot} {
    catch {file delete -force -- tfa}
    file mkdir tfa
    createfile tfa/a
    file attributes tfa -permissions 0555
    set result [catch  {file delete tfa/a }]
    #######
    #######  If any directory in a tree that is being removed does not 
    #######  have write permission, the process will fail!
    #######  This is also the case with "rm -rf"
    #######
    file attributes tfa -permissions 0777
    file delete -force tfa
    set result
} {1}

test fCmd-16.10 {deleting multiple files} {notRoot} {
    catch {file delete -force -- tfa1 tfa2}
    createfile tfa1
    createfile tfa2
    file delete tfa1 tfa2
    expr ![file exists tfa1] && ![file exists tfa2]
} {1}

test fCmd-16.11 {TclFileDeleteCmd: removing a nonexistant file} {notRoot} {
    catch {file delete -force -- tfa}
    file delete tfa
    set result 1
} {1}

# More coverage tests for mkpath()
 test fCmd-17.1 {mkdir stat failing on target but not ENOENT} {unixOnly notRoot} {
     catch {file delete -force -- tfa1}
     file mkdir tfa1
     file attributes tfa1 -permissions 0555
     set result [catch {file mkdir tfa1/tfa2}]
     file attributes tfa1 -permissions 0777
     file delete -force tfa1
     set result
} {1}

test fCmd-17.2 {mkdir several levels deep - relative } {notRoot} {
    catch {file delete -force -- tfa}
    file mkdir tfa/a/b
    set result [file isdir tfa/a/b ]
    file delete tfa/a/b tfa/a tfa
    set result
} {1}

test fCmd-17.3 {mkdir several levels deep - absolute } {notRoot} {
    catch {file delete -force -- tfa}
    set f [file join [pwd] tfa a ]
    file mkdir $f
    set result [file isdir $f ]
    file delete $f [file join [pwd] tfa]
    set result
} {1}

#
# Functionality tests for TclFileRenameCmd()
#

test fCmd-18.1 {TclFileRenameCmd: rename (first form) in the same directory} \
	{notRoot} {
    catch {file delete -force -- tfad}
    file mkdir tfad/dir
    cd tfad/dir
    set s [createfile foo ]
    file rename  foo bar
    file rename bar ./foo
    file rename ./foo bar
    file rename ./bar ./foo
    file rename foo ../dir/bar
    file rename ../dir/bar ./foo
    file rename ../../tfad/dir/foo ../../tfad/dir/bar
    file rename [file join [pwd] bar] foo
    file rename foo [file join [pwd] bar]
    set result [expr [checkcontent bar $s] && ![file exists foo]]
    cd ../..
    file delete -force tfad
    set result
} {1}

test fCmd-18.2 {TclFileRenameCmd: single dir to nonexistant} {notRoot} {
    catch {file delete -force -- tfa1 tfa2}
    file mkdir tfa1
    file rename tfa1 tfa2
    set result [expr [file exists tfa2] && ![file exists tfa1]]
    file delete tfa2
    set result
} {1}

test fCmd-18.3 {TclFileRenameCmd: mixed dirs and files into directory} {notRoot} {
    catch {file delete -force -- tfa1 tfad1 tfad2}
    set s [createfile tfa1 ]
    file mkdir tfad1 tfad2
    file rename tfa1 tfad1 tfad2
    set r1 [checkcontent  tfad2/tfa1 $s]
    set r2 [file isdir tfad2/tfad1]
    set result [expr $r1 && $r2 && ![file exists tfa1] && ![file exists tfad1]]
    file delete tfad2/tfa1
    file delete -force tfad2
    set result
} {1}

test fCmd-18.4 {TclFileRenameCmd: attempt to replace non-dir with dir} {notRoot} {
    catch {file delete -force -- tfa tfad}
    set s [createfile tfa ]
    file mkdir tfad