cmdah.test

linux系统下的音频通信

} {1 {user "_bad_user" doesn't exist}}

testsetplatform $platform
}

# readable

if {[info commands testchmod] == {}} {
    puts "This application hasn't been compiled with the \"testchmod\""
    puts "command, so I can't test Tcl_FileObjCmd etc."
} else {
makeFile abcde gorp.file
makeDirectory dir.file

test cmdAH-12.1 {Tcl_FileObjCmd: readable} {
    list [catch {file readable a b} msg] $msg
} {1 {wrong # args: should be "file readable name"}}
testchmod 444 gorp.file
test cmdAH-12.2 {Tcl_FileObjCmd: readable} {
    file readable gorp.file
} 1
testchmod 333 gorp.file
test cmdAH-12.3 {Tcl_FileObjCmd: readable} {unixOnly && !root} {
    file reada gorp.file
} 0

# writable

test cmdAH-13.1 {Tcl_FileObjCmd: writable} {
    list [catch {file writable a b} msg] $msg
} {1 {wrong # args: should be "file writable name"}}
testchmod 555 gorp.file
test cmdAH-13.2 {Tcl_FileObjCmd: writable} {!root} {
    file writable gorp.file
} 0
testchmod 222 gorp.file
test cmdAH-13.3 {Tcl_FileObjCmd: writable} {
    file writable gorp.file
} 1

# executable

file delete -force dir.file gorp.file
file mkdir dir.file
makeFile abcde gorp.file

test cmdAH-14.1 {Tcl_FileObjCmd: executable} {
    list [catch {file executable a b} msg] $msg
} {1 {wrong # args: should be "file executable name"}}
test cmdAH-14.2 {Tcl_FileObjCmd: executable} {
    file executable gorp.file
} 0
test cmdAH-14.3 {Tcl_FileObjCmd: executable} {unix} {
    # Only on unix will setting the execute bit on a regular file
    # cause that file to be executable.   
    
    testchmod 775 gorp.file
    file exe gorp.file
} 1

test cmdAH-14.4 {Tcl_FileObjCmd: executable} {mac} {
    # On mac, the only executable files are of type APPL.

    set x [file exe gorp.file]    
    file attrib gorp.file -type APPL
    lappend x [file exe gorp.file]
} {0 1}
test cmdAH-14.5 {Tcl_FileObjCmd: executable} {pc} {
    # On pc, must be a .exe, .com, etc.
    
    set x [file exe gorp.file]
    makeFile foo gorp.exe
    lappend x [file exe gorp.exe]
    file delete gorp.exe
    set x
} {0 1}
test cmdAH-14.6 {Tcl_FileObjCmd: executable} {
    # Directories are always executable.
    
    file exe dir.file
} 1

file delete -force dir.file  
file delete gorp.file
file delete link.file
}

# exists

test cmdAH-15.1 {Tcl_FileObjCmd: exists} {
    list [catch {file exists a b} msg] $msg
} {1 {wrong # args: should be "file exists name"}}
test cmdAH-15.2 {Tcl_FileObjCmd: exists} {file exists gorp.file} 0
test cmdAH-15.3 {Tcl_FileObjCmd: exists} {
    file exists [file join dir.file gorp.file]
} 0
catch {
    makeFile abcde gorp.file
    makeDirectory dir.file
    makeFile 12345 [file join dir.file gorp.file]
}
test cmdAH-15.4 {Tcl_FileObjCmd: exists} {
    file exists gorp.file
} 1
test cmdAH-15.5 {Tcl_FileObjCmd: exists} {
    file exists [file join dir.file gorp.file]
} 1

# nativename
if {[info commands testsetplatform] == {}} {
    puts "This application hasn't been compiled with the \"testsetplatform\""
    puts "command, so I can't test Tcl_FileObjCmd etc."
} else {
test cmdAH-15.6 {Tcl_FileObjCmd: nativename} {
    testsetplatform unix
    list [catch {file nativename a/b} msg] $msg [testsetplatform $platform]
} {0 a/b {}}
test cmdAH-15.7 {Tcl_FileObjCmd: nativename} {
    testsetplatform windows
    list [catch {file nativename a/b} msg] $msg [testsetplatform $platform]
} {0 {a\b} {}}
test cmdAH-15.8 {Tcl_FileObjCmd: nativename} {
    testsetplatform mac
    list [catch {file nativename a/b} msg] $msg [testsetplatform $platform]
} {0 :a:b {}}
}

test cmdAH-15.9 {Tcl_FileObjCmd: ~ : exists} {
    file exists ~nOsUcHuSeR
} 0
test cmdAH-15.10 {Tcl_FileObjCmd: ~ : nativename} {
    # should probably be 0 in fact...
    catch {file nativename ~nOsUcHuSeR}
} 1

# The test below has to be done in /tmp rather than the current
# directory in order to guarantee (?) a local file system:  some
# NFS file systems won't do the stuff below correctly.

if {$tcl_platform(platform) == "unix"} {
    file delete /tmp/tcl.foo.dir/file
    removeDirectory /tmp/tcl.foo.dir
    makeDirectory /tmp/tcl.foo.dir
    makeFile 12345 /tmp/tcl.foo.dir/file
    exec chmod 000 /tmp/tcl.foo.dir
    if {$user != "root"} {
	test cmdAH-15.9 {Tcl_FileObjCmd: exists} {
	    file exists /tmp/tcl.foo.dir/file
	} 0
    }
    exec chmod 775 /tmp/tcl.foo.dir
    file delete /tmp/tcl.foo.dir/file
    removeDirectory /tmp/tcl.foo.dir
}

# Stat related commands

catch {testsetplatform $platform}
file delete gorp.file
makeFile "Test string" gorp.file
catch {exec chmod 765 gorp.file}

# atime

test cmdAH-16.1 {Tcl_FileObjCmd: atime} {
    list [catch {file atime a b} msg] $msg
} {1 {wrong # args: should be "file atime name"}}
test cmdAH-16.2 {Tcl_FileObjCmd: atime} {
    catch {unset stat}
    file stat gorp.file stat
    list [expr {[file mtime gorp.file] == $stat(mtime)}] \
	    [expr {[file atime gorp.file] == $stat(atime)}]
} {1 1}
test cmdAH-16.3 {Tcl_FileObjCmd: atime} {
    string tolower [list [catch {file atime _bogus_} msg] \
	    $msg $errorCode]
} {1 {couldn't stat "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}

# isdirectory

test cmdAH-17.1 {Tcl_FileObjCmd: isdirectory} {
    list [catch {file isdirectory a b} msg] $msg
} {1 {wrong # args: should be "file isdirectory name"}}
test cmdAH-17.2 {Tcl_FileObjCmd: isdirectory} {
    file isdirectory gorp.file
} 0
test cmdAH-17.3 {Tcl_FileObjCmd: isdirectory} {
    file isd dir.file
} 1

# isfile

test cmdAH-18.1 {Tcl_FileObjCmd: isfile} {
    list [catch {file isfile a b} msg] $msg
} {1 {wrong # args: should be "file isfile name"}}
test cmdAH-18.2 {Tcl_FileObjCmd: isfile} {file isfile gorp.file} 1
test cmdAH-18.3 {Tcl_FileObjCmd: isfile} {file isfile dir.file} 0

# lstat and readlink:  don't run these tests everywhere, since not all
# sites will have symbolic links

catch {exec ln -s gorp.file link.file}
test cmdAH-19.1 {Tcl_FileObjCmd: lstat} {
    list [catch {file lstat a} msg] $msg
} {1 {wrong # args: should be "file lstat name varName"}}
test cmdAH-19.2 {Tcl_FileObjCmd: lstat} {
    list [catch {file lstat a b c} msg] $msg
} {1 {wrong # args: should be "file lstat name varName"}}
test cmdAH-19.3 {Tcl_FileObjCmd: lstat} {unixOnly nonPortable} {
    catch {unset stat}
    file lstat link.file stat
    lsort [array names stat]
} {atime ctime dev gid ino mode mtime nlink size type uid}
test cmdAH-19.4 {Tcl_FileObjCmd: lstat} {unixOnly nonPortable} {
    catch {unset stat}
    file lstat link.file stat
    list $stat(nlink) [expr $stat(mode)&0777] $stat(type)
} {1 511 link}
test cmdAH-19.5 {Tcl_FileObjCmd: lstat errors} {nonPortable} {
    string tolower [list [catch {file lstat _bogus_ stat} msg] \
	    $msg $errorCode]
} {1 {couldn't lstat "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
test cmdAH-19.6 {Tcl_FileObjCmd: lstat errors} {
    catch {unset x}
    set x 44
    list [catch {file lstat gorp.file x} msg] $msg $errorCode
} {1 {can't set "x(dev)": variable isn't array} NONE}
catch {unset stat}

# mtime 

test cmdAH-20.1 {Tcl_FileObjCmd: mtime} {
    list [catch {file mtime a b} msg] $msg
} {1 {wrong # args: should be "file mtime name"}}
test cmdAH-20.2 {Tcl_FileObjCmd: mtime} {
    set old [file mtime gorp.file]
    after 2000
    set f [open gorp.file w]
    puts $f "More text"
    close $f
    set new [file mtime gorp.file]
    expr {($new > $old) && ($new <= ($old+5))}
} {1}
test cmdAH-20.3 {Tcl_FileObjCmd: mtime} {
    catch {unset stat}
    file stat gorp.file stat
    list [expr {[file mtime gorp.file] == $stat(mtime)}] \
	    [expr {[file atime gorp.file] == $stat(atime)}]
} {1 1}
test cmdAH-20.4 {Tcl_FileObjCmd: mtime} {
    string tolower [list [catch {file mtime _bogus_} msg] $msg \
	    $errorCode]
} {1 {couldn't stat "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
test cmdAH-20.5 {Tcl_FileObjCmd: mtime} {
    # Under Unix, use a file in /tmp to avoid clock skew due to NFS.
    # On other platforms, just use a file in the local directory.

    if {$tcl_platform(platform) == "unix"} {
	 set name /tmp/tcl.test
    } else {
	set name tf
    }

    # Borland file times were off by timezone.  Make sure that a new file's
    # time is correct.  10 seconds variance is allowed used due to slow
    # networks or clock skew on a network drive.

    file delete -force $name
    close [open $name w]
    set a [expr abs([clock seconds]-[file mtime $name])<10]
    file delete $name
    set a
} {1}


# owned

test cmdAH-21.1 {Tcl_FileObjCmd: owned} {
    list [catch {file owned a b} msg] $msg
} {1 {wrong # args: should be "file owned name"}}
test cmdAH-21.2 {Tcl_FileObjCmd: owned} {
    file owned gorp.file
} 1
test cmdAH-21.3 {Tcl_FileObjCmd: owned} {unixOnly && !root} {
    file owned /
} 0

# readlink

test cmdAH-22.1 {Tcl_FileObjCmd: readlink} {
    list [catch {file readlink a b} msg] $msg
} {1 {wrong # args: should be "file readlink name"}}
test cmdAH-22.2 {Tcl_FileObjCmd: readlink} {unixOnly nonPortable} {
    file readlink link.file
} gorp.file
test cmdAH-22.3 {Tcl_FileObjCmd: readlink errors} {unixOnly nonPortable} {
    list [catch {file readlink _bogus_} msg] [string tolower $msg] \
	    [string tolower $errorCode]
} {1 {couldn't readlink "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
test cmdAH-22.4 {Tcl_FileObjCmd: readlink errors} {macOnly nonPortable} {
    list [catch {file readlink _bogus_} msg] [string tolower $msg] \
	    [string tolower $errorCode]
} {1 {couldn't readlink "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
test cmdAH-22.5 {Tcl_FileObjCmd: readlink errors} {pcOnly nonPortable} {
    list [catch {file readlink _bogus_} msg] [string tolower $msg] \
	    [string tolower $errorCode]
} {1 {couldn't readlink "_bogus_": invalid argument} {posix einval {invalid argument}}}

# size

test cmdAH-23.1 {Tcl_FileObjCmd: size} {
    list [catch {file size a b} msg] $msg
} {1 {wrong # args: should be "file size name"}}
test cmdAH-23.2 {Tcl_FileObjCmd: size} {
    set oldsize [file size gorp.file]
    set f [open gorp.file a]
    fconfigure $f -translation lf -eofchar {}
    puts $f "More text"
    close $f
    expr {[file size gorp.file] - $oldsize}
} {10}
test cmdAH-23.3 {Tcl_FileObjCmd: size} {
    string tolower [list [catch {file size _bogus_} msg] $msg \
	    $errorCode]
} {1 {couldn't stat "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}

# stat

catch {testsetplatform $platform}
makeFile "Test string" gorp.file
catch {exec chmod 765 gorp.file}

test cmdAH-24.1 {Tcl_FileObjCmd: stat} {
    list [catch {file stat _bogus_} msg] $msg $errorCode
} {1 {wrong # args: should be "file stat name varName"} NONE}
test cmdAH-24.2 {Tcl_FileObjCmd: stat} {
    list [catch {file stat _bogus_ a b} msg] $msg $errorCode
} {1 {wrong # args: should be "file stat name varName"} NONE}
test cmdAH-24.3 {Tcl_FileObjCmd: stat} {
    catch {unset stat}
    file stat gorp.file stat
    lsort [array names stat]
} {atime ctime dev gid ino mode mtime nlink size type uid}
test cmdAH-24.4 {Tcl_FileObjCmd: stat} {
    catch {unset stat}
    file stat gorp.file stat
    list $stat(nlink) $stat(size) $stat(type)
} {1 12 file}
test cmdAH-24.5 {Tcl_FileObjCmd: stat} {unix} {
    catch {unset stat}
    file stat gorp.file stat
    expr $stat(mode)&0777
} {501}
test cmdAH-24.6 {Tcl_FileObjCmd: stat} {
    string tolower [list [catch {file stat _bogus_ stat} msg] \
	    $msg $errorCode]
} {1 {couldn't stat "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
test cmdAH-24.7 {Tcl_FileObjCmd: stat} {
    catch {unset x}
    set x 44
    list [catch {file stat gorp.file x} msg] $msg $errorCode
} {1 {can't set "x(dev)": variable isn't array} NONE}
catch {unset stat}

# type

file delete link.file

test cmdAH-25.1 {Tcl_FileObjCmd: type} {
    list [catch {file size a b} msg] $msg
} {1 {wrong # args: should be "file size name"}}
test cmdAH-25.2 {Tcl_FileObjCmd: type} {
    file type dir.file
} directory
test cmdAH-25.3 {Tcl_FileObjCmd: type} {
    file type gorp.file
} file
test cmdAH-25.4 {Tcl_FileObjCmd: type} {unixOnly nonPortable} {
    exec ln -s a/b/c link.file
    set result [file type link.file]
    file delete link.file
    set result
} link
test cmdAH-25.5 {Tcl_FileObjCmd: type} {
    string tolower [list [catch {file type _bogus_} msg] $msg $errorCode]
} {1 {couldn't stat "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}

# Error conditions

test cmdAH-26.1 {error conditions} {
    list [catch {file gorp x} msg] $msg
} {1 {bad option "gorp": must be atime, attributes, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}}
test cmdAH-26.2 {error conditions} {
    list [catch {file ex x} msg] $msg
} {1 {ambiguous option "ex": must be atime, attributes, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}}
test cmdAH-26.3 {error conditions} {
    list [catch {file is x} msg] $msg
} {1 {ambiguous option "is": must be atime, attributes, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}}
test cmdAH-26.4 {error conditions} {
    list [catch {file z x} msg] $msg
} {1 {bad option "z": must be atime, attributes, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}}
test cmdAH-26.5 {error conditions} {
    list [catch {file read x} msg] $msg
} {1 {ambiguous option "read": must be atime, attributes, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}}
test cmdAH-26.6 {error conditions} {
    list [catch {file s x} msg] $msg
} {1 {ambiguous option "s": must be atime, attributes, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}}
test cmdAH-26.7 {error conditions} {
    list [catch {file t x} msg] $msg
} {1 {ambiguous option "t": must be atime, attributes, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}}
test cmdAH-26.8 {error conditions} {
    list [catch {file dirname ~woohgy} msg] $msg
} {1 {user "woohgy" doesn't exist}}

catch {testsetplatform $platform}
catch {unset platform}

catch {exec chmod 777 dir.file}
file delete -force dir.file
file delete gorp.file
file delete link.file

concat ""