fcmd.test

linux系统下的音频通信

    file delete -force tfa1 tfa2 tfa3
    set result
} {1}

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

    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} {
    catch {file delete -force -- tfa1 tfalink}
	
    file mkdir tfa1
    exec ln -s tfa1 tfalink
    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 } {
    catch {file delete -force -- tfa}
    file mkdir tfa
    file delete tfa
    file exists tfa
} {0}

test fCmd-19.2 { rmdir error besides EEXIST} {unixOnly} {
    catch {file delete -force -- tfa}
    file mkdir tfa
    file mkdir tfa/a
    exec chmod 555 tfa
    set result [catch {file delete tfa/a}]
    exec chmod 777 tfa
    file delete -force tfa
    set result
} {1}

test fCmd-19.3 { recursive remove } {
    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} {
    catch {file delete -force -- tfa}
    file mkdir tfa
    file mkdir tfa/a
    exec chmod 000 tfa/a
    set result [catch {file delete -force tfa}]
    exec chmod 777 tfa/a
    file delete -force tfa
    set result
} {1}


#
# Feature testing for TclCopyFilesCmd
# 
test fCmd-21.1 {copy : single file to nonexistant } {
    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 } {
    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  } {
    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} {
    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  } {
    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  } {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 {TclCopyFilesCmd : copy a dangling link } {unixOnly} {
    file mkdir tfad1
    exec ln -s tfad1 tfalink
    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 {TclCopyFilesCmd : copy a link } {unixOnly} {
    file mkdir tfad1
    exec ln -s tfad1 tfalink
    file copy tfalink tfalink2
    set r1 [file type tfalink]
    set r2 [file type tfalink2]
    set r3 [file isdir tfad1]
    set result [expr {("$r1" == "link" ) && ("$r2" == "link" ) && $r3}]
    file delete tfad1 tfalink tfalink2
    set result
} {1}

test fCmd-21.9 {TclCopyFilesCmd : copy dir with a link in it } {unixOnly} {
    file mkdir tfad1
    exec ln -s "[pwd]/tfad1" tfad1/tfalink
    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} {
    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} {
    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} {
    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 } {
    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} {
    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 } {
    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 } {
    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 } {
    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 tfa1 $s]]
    file delete tfa1 tfa2
    set result
} {1}

#
# TclMacMkdir - basic cases are covered elsewhere.
# Error cases are not covered.
#

#
# TclMacRmdir
# Error cases are not covered.
#

test fCmd-23.1 { TclMacRmdir : trying to remove a nonempty directory } {
    catch {file delete -force -- tfad}
	
    file mkdir [file join tfad dir]
	
    set result [catch {file delete tfad}]
    file delete -force tfad 
    set result
} {1}

#
# TclMacDeleteFile	
# Error cases are not covered.
#
test fCmd-24.1 { TclMacDeleteFile : deleting a normal file } {
    catch {file delete -force -- tfa1}
	
    createfile tfa1
    file delete tfa1
    file exists tfa1
} {0}

#
# TclMacCopyDirectory
# Error cases are not covered.
#
test fCmd-25.1 { TclMacCopyDirectory : copying a normal directory} {notFileSharing} {
    catch {file delete -force -- tfad1 tfad2}
		
    file mkdir [file join tfad1 a b c]
    file copy tfad1 tfad2
    set result [expr [file isdir [file join tfad1 a b c]] && [file isdir [file join tfad2 a b c]]]
    file delete -force tfad1 tfad2
    set result
} {1}

test fCmd-25.2 { TclMacCopyDirectory : copying a short path normal directory} {notFileSharing} {
    catch {file delete -force -- tfad1 tfad2}
		
    file mkdir tfad1
    file copy tfad1 tfad2
    set result [expr [file isdir tfad1] && [file isdir tfad2]]
    file delete tfad1 tfad2
    set result
} {1}

test fCmd-25.3 { TclMacCopyDirectory : copying dirs between different dirs} {notFileSharing} {
    catch {file delete -force -- tfad1 tfad2}
		
    file mkdir [file join tfad1 x y z]
    file mkdir [file join tfad2 dir]
    file copy tfad1 [file join tfad2 dir]
    set result [expr [file isdir [file join tfad1 x y z]] && [file isdir [file join tfad2 dir tfad1 x y z]]]
    file delete -force tfad1 tfad2
    set result
} {1}

#
# Functionality tests for TclDeleteFilesCmd
#

test fCmd-26.1 { TclDeleteFilesCmd : delete symlink} {unixOnly} {
    catch {file delete -force -- tfad1 tfad2}
		
    file mkdir tfad1
    exec ln -s tfad1 tfalink
    file delete tfalink

    set r1 [file isdir tfad1]
    set r2 [file exists tfalink]
    
    set result [expr $r1 && !$r2]
    file delete tfad1
    set result
} {1}

test fCmd-26.2 { TclDeleteFilesCmd : delete dir with symlink} {unixOnly} {
    catch {file delete -force -- tfad1 tfad2}
		
    file mkdir tfad1
    file mkdir tfad2
    exec ln -s tfad1 [file join tfad2 link]
    file delete -force tfad2

    set r1 [file isdir tfad1]
    set r2 [file exists tfad2]
    
    set result [expr $r1 && !$r2]
    file delete tfad1
    set result
} {1}

test fCmd-26.3 { TclDeleteFilesCmd : delete dangling symlink} {unixOnly} {
    catch {file delete -force -- tfad1 tfad2}
		
    file mkdir tfad1
    exec ln -s tfad1 tfad2
    file delete tfad1
    file delete tfad2

    set r1 [file exists tfad1]
    set r2 [file exists tfad2]
    
    set result [expr !$r1 && !$r2]
    set result
} {1}

test fCmd-27.1 {TclFileAttrsCmd - wrong # args} {
    list [catch {file attributes a b c d} msg] $msg
} {1 {wrong # args: must be "file attributes name ?option? ?value? ?option value? ..."}}
test fCmd-27.2 {TclFileAttrsCmd - Tcl_TranslateFileName fails} {
    testsetplatform unix
    list [catch {file attributes ~_bad_user} msg] $msg [testsetplatform $platform]
} {1 {user "_bad_user" doesn't exist} {}}
test fCmd-27.3 {TclFileAttrsCmd - all attributes} {
    catch {file delete -force -- foo.tmp}
    createfile foo.tmp
    list [catch {file attributes foo.tmp} msg] [expr {[llength $msg] > 0}] [file delete -force -- foo.tmp]
} {0 1 {}}
test fCmd-27.4 {TclFileAttrsCmd - getting one option} {
    catch {file delete -force -- foo.tmp}
    createfile foo.tmp
    set attrs [file attributes foo.tmp]
    list [catch {eval file attributes foo.tmp [lindex $attrs 0]}] [file delete -force -- foo.tmp]
} {0 {}}

set testConfig(tclGroup) 0
if {($tcl_platform(platform) == "macintosh") \
	|| ($tcl_platform(platform) == "windows")} {
    set testConfig(tclGroup) 1
} elseif {[catch {exec {groups}} groupList] == 0} {
    if {[lsearch $groupList tcl] != -1} {
	set testConfig(tclGroup) 1
    }
}

test fCmd-27.5 {TclFileAttrsCmd - setting one option} {tclGroup} {
    catch {file delete -force -- foo.tmp}
    createfile foo.tmp
    set attrs [file attributes foo.tmp]
    list [catch {eval file attributes foo.tmp [lrange $attrs 0 1]} ms