io.test

linux系统下的音频通信

# Functionality covered: operation of all IO commands, and all procedures
# defined in generic/tclIO.c.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# SCCS: @(#) io.test 1.131 97/09/22 11:15:05

if {[string compare test [info procs test]] == 1} then {source defs}

if {"[info commands testchannel]" != "testchannel"} {
    puts "Skipping io tests. This application does not seem to have the"
    puts "testchannel command that is needed to run these tests."
    return
}

removeFile test1
removeFile pipe

# set up a long data file for some of the following tests

set f [open longfile w]
fconfigure $f -eofchar {} -translation lf
for { set i 0 } { $i < 100 } { incr i} {
    puts $f "#123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef
\#123456789abcdef01
\#"
    }
close $f

set f [open cat w]
puts $f {
    if {$argv == {}} {
	set argv -
    }
    foreach name $argv {
	if {$name == "-"} {
	    set f stdin
	} elseif {[catch {open $name r} f] != 0} {
	    puts stderr $f
	    continue
	}
	while {[eof $f] == 0} {
	    puts -nonewline stdout [read $f]
	}
	if {$f != "stdin"} {
	    close $f
	}
    }
}
close $f

# These tests are disabled until we decide what to do with "unsupported0".
#
#test io-1.7 {unsupported0 command} {
#    removeFile test1
#    set f1 [open iocmd.test]
#    set f2 [open test1 w]
#    unsupported0 $f1 $f2
#    close $f1
#    catch {close $f2}
#    set s1 [file size [info script]]
#    set s2 [file size test1]
#    set x ok
#    if {"$s1" != "$s2"} {
#        set x broken
#    }
#    set x
#} ok
#test io-1.8 {unsupported0 command} {
#    removeFile test1
#    set f1 [open [info script]]
#    set f2 [open test1 w]
#    unsupported0 $f1 $f2 40
#    close $f1
#    close $f2
#    file size test1
#} 40
#test io-1.9 {unsupported0 command} {
#    removeFile test1
#    set f1 [open [info script]]
#    set f2 [open test1 w]
#    unsupported0 $f1 $f2 -1
#    close $f1
#    close $f2
#    set x ok
#    set s1 [file size [info script]]
#    set s2 [file size test1]
#    if {$s1 != $s2} {
#        set x broken
#    }
#    set x
#} ok
#test io-1.10 {unsupported0 command} {unixOrPc} {
#    removeFile pipe
#    removeFile test1
#    set f1 [open pipe w]
#    puts $f1 {puts ready}
#    puts $f1 {gets stdin}
#    puts $f1 {set f1 [open [info script] r]}
#    puts $f1 {puts [read $f1 100]}
#    puts $f1 {close $f1}
#    close $f1
#    set f1 [open "|[list $tcltest pipe]" r+]
#    gets $f1
#    puts $f1 ready
#    flush $f1
#    set f2 [open test1 w]
#    set c [unsupported0 $f1 $f2 40]
#    catch {close $f1}
#    close $f2
#    set s1 [file size test1]
#    set x ok
#    if {$s1 != "40"} {
#        set x broken
#    }
#    list $c $x
#} {40 ok}

# Test standard handle management. The functions tested are
# Tcl_SetStdChannel and Tcl_GetStdChannel. Incidentally we are
# also testing channel table management.

if {$tcl_platform(platform) == "macintosh"} {
    set consoleFileNames [list console0 console1 console2]
} else {
    set consoleFileNames [lsort [testchannel open]]
}
test io-1.1 {Tcl_SetStdChannel and Tcl_GetStdChannel} {
    set l ""
    lappend l [fconfigure stdin -buffering]
    lappend l [fconfigure stdout -buffering]
    lappend l [fconfigure stderr -buffering]
    lappend l [lsort [testchannel open]]
    set l
} [list line line none $consoleFileNames]
test io-1.2 {Tcl_SetStdChannel and Tcl_GetStdChannel} {
    interp create x
    set l ""
    lappend l [x eval {fconfigure stdin -buffering}]
    lappend l [x eval {fconfigure stdout -buffering}]
    lappend l [x eval {fconfigure stderr -buffering}]
    interp delete x
    set l
} {line line none}
test io-1.3 {Tcl_SetStdChannel & Tcl_GetStdChannel} {stdio} {
    set f [open test1 w]
    puts $f {
	close stdin
	close stdout
	close stderr
	set f [open test1 r]
	set f2 [open test2 w]
	set f3 [open test3 w]
	puts stdout [gets stdin]
	puts stdout out
	puts stderr err
	close $f
	close $f2
	close $f3
    }
    close $f
    set result [exec $tcltest test1]
    set f [open test2 r]
    set f2 [open test3 r]
    lappend result [read $f] [read $f2]
    close $f
    close $f2
    set result
} {{
out
} {err
}}
# This test relies on the fact that the smallest available fd is used first.
test io-1.4 {Tcl_SetStdChannel & Tcl_GetStdChannel} {unixOnly} {
    set f [open test1 w]
    puts $f { close stdin
	close stdout
	close stderr
	set f [open test1 r]
	set f2 [open test2 w]
	set f3 [open test3 w]
	puts stdout [gets stdin]
	puts stdout $f2
	puts stderr $f3
	close $f
	close $f2
	close $f3
    }
    close $f
    set result [exec $tcltest test1]
    set f [open test2 r]
    set f2 [open test3 r]
    lappend result [read $f] [read $f2]
    close $f
    close $f2
    set result
} {{ close stdin
file1
} {file2
}}
catch {interp delete z}
test io-1.5 {Tcl_GetChannel: stdio name translation} {
    interp create z
    eof stdin
    catch {z eval flush stdin} msg1
    catch {z eval close stdin} msg2
    catch {z eval flush stdin} msg3
    set result [list $msg1 $msg2 $msg3]
    interp delete z
    set result
} {{channel "stdin" wasn't opened for writing} {} {can not find channel named "stdin"}}
test io-1.6 {Tcl_GetChannel: stdio name translation} {
    interp create z
    eof stdout
    catch {z eval flush stdout} msg1
    catch {z eval close stdout} msg2
    catch {z eval flush stdout} msg3
    set result [list $msg1 $msg2 $msg3]
    interp delete z
    set result
} {{} {} {can not find channel named "stdout"}}
test io-1.7 {Tcl_GetChannel: stdio name translation} {
    interp create z
    eof stderr
    catch {z eval flush stderr} msg1
    catch {z eval close stderr} msg2
    catch {z eval flush stderr} msg3
    set result [list $msg1 $msg2 $msg3]
    interp delete z
    set result
} {{} {} {can not find channel named "stderr"}}
test io-1.8 {reuse of stdio special channels} {unixOnly} {
    removeFile script
    removeFile test1
    set f [open script w]
    puts $f {
	close stderr
	set f [open test1 w]
	puts stderr hello
	close $f
	set f [open test1 r]
	puts [gets $f]
    }
    close $f
    set f [open "|[list $tcltest script]" r]
    set c [gets $f]
    close $f
    set c
} hello
test io-1.9 {reuse of stdio special channels} {stdio} {
    removeFile script
    removeFile test1
    set f [open script w]
    puts $f {
	set f [open test1 w]
	puts $f hello
	close $f
	close stderr
	set f [open "|[list [info nameofexecutable] cat test1]" r]
	puts [gets $f]
    }
    close $f
    set f [open "|[list $tcltest script]" r]
    set c [gets $f]
    close $f
    set c
} hello

# Must add test function for testing Tcl_CreateCloseHandler and
# Tcl_DeleteCloseHandler.

# Test channel table management. The functions tested are
# GetChannelTable, DeleteChannelTable, Tcl_RegisterChannel,
# Tcl_UnregisterChannel, Tcl_GetChannel and Tcl_CreateChannel.
#
# These functions use "eof stdin" to ensure that the standard
# channels are added to the channel table of the interpreter.

test io-2.1 {GetChannelTable, DeleteChannelTable on std handles} {
    set l1 [testchannel refcount stdin]
    eof stdin
    interp create x
    set l ""
    lappend l [expr [testchannel refcount stdin] - $l1]
    x eval {eof stdin}
    lappend l [expr [testchannel refcount stdin] - $l1]
    interp delete x
    lappend l [expr [testchannel refcount stdin] - $l1]
    set l
} {0 1 0}
test io-2.2 {GetChannelTable, DeleteChannelTable on std handles} {
    set l1 [testchannel refcount stdout]
    eof stdin
    interp create x
    set l ""
    lappend l [expr [testchannel refcount stdout] - $l1]
    x eval {eof stdout}
    lappend l [expr [testchannel refcount stdout] - $l1]
    interp delete x
    lappend l [expr [testchannel refcount stdout] - $l1]
    set l
} {0 1 0}
test io-2.3 {GetChannelTable, DeleteChannelTable on std handles} {
    set l1 [testchannel refcount stderr]
    eof stdin
    interp create x
    set l ""
    lappend l [expr [testchannel refcount stderr] - $l1]
    x eval {eof stderr}
    lappend l [expr [testchannel refcount stderr] - $l1]
    interp delete x
    lappend l [expr [testchannel refcount stderr] - $l1]
    set l
} {0 1 0}
test io-2.4 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {
    removeFile test1
    set l ""
    set f [open test1 w]
    lappend l [lindex [testchannel info $f] 15]
    close $f
    if {[catch {lindex [testchannel info $f] 15} msg]} {
	lappend l $msg
    } else {
	lappend l "very broken: $f found after being closed"
    }
    string compare [string tolower $l] \
	[list 1 [format "can not find channel named \"%s\"" $f]]
} 0
test io-2.5 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {
    removeFile test1
    set l ""
    set f [open test1 w]
    lappend l [lindex [testchannel info $f] 15]
    interp create x
    interp share "" $f x
    lappend l [lindex [testchannel info $f] 15]
    x eval close $f
    lappend l [lindex [testchannel info $f] 15]
    interp delete x
    lappend l [lindex [testchannel info $f] 15]
    close $f
    if {[catch {lindex [testchannel info $f] 15} msg]} {
	lappend l $msg
    } else {
	lappend l "very broken: $f found after being closed"
    }
    string compare [string tolower $l] \
	[list 1 2 1 1 [format "can not find channel named \"%s\"" $f]]
} 0
test io-2.6 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {
    removeFile test1
    set l ""
    set f [open test1 w]
    lappend l [lindex [testchannel info $f] 15]
    interp create x
    interp share "" $f x
    lappend l [lindex [testchannel info $f] 15]
    interp delete x
    lappend l [lindex [testchannel info $f] 15]
    close $f
    if {[catch {lindex [testchannel info $f] 15} msg]} {
	lappend l $msg
    } else {
	lappend l "very broken: $f found after being closed"
    }
    string compare [string tolower $l] \
	[list 1 2 1 [format "can not find channel named \"%s\"" $f]]
} 0
test io-2.7 {Tcl_GetChannel->Tcl_GetStdChannel, standard handles} {
    eof stdin
} 0
test io-2.8 {testing Tcl_GetChannel, user opened handle} {
    removeFile test1
    set f [open test1 w]
    set x [eof $f]
    close $f
    set x
} 0
test io-2.9 {Tcl_GetChannel, channel not found} {
    list [catch {eof file34} msg] $msg
} {1 {can not find channel named "file34"}}
test io-2.10 {Tcl_CreateChannel, insertion into channel table} {
    removeFile test1
    set f [open test1 w]
    set l ""
    lappend l [eof $f]
    close $f
    if {[catch {lindex [testchannel info $f] 15} msg]} {
	lappend l $msg
    } else {
	lappend l "very broken: $f found after being closed"
    }
    string compare [string tolower $l] \
	[list 0 [format "can not find channel named \"%s\"" $f]]
} 0

# Test management of attributes associated with a channel, such as
# its default translation, its name and type, etc. The functions
# tested in this group are Tcl_GetChannelName,
# Tcl_GetChannelType and Tcl_GetChannelFile. Tcl_GetChannelInstanceData
# not tested because files do not use the instance data.

test io-3.1 {Tcl_GetChannelName} {
    removeFile test1
    set f [open test1 w]
    set n [testchannel name $f]
    close $f
    string compare $n $f
} 0
test io-3.2 {Tcl_GetChannelType} {
    removeFile test1
    set f [open test1 w]
    set t [testchannel type $f]
    close $f
    string compare $t file
} 0
test io-3.3 {Tcl_GetChannelFile, input} {
    set f [open test1 w]
    fconfigure $f -translation lf -eofchar {}
    puts $f "1234567890\n098765432"
    close $f
    set f [open test1 r]
    gets $f
    set l ""
    lappend l [testchannel inputbuffered $f]
    lappend l [tell $f]
    close $f
    set l
} {10 11}
test io-3.4 {Tcl_GetChannelFile, output} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf
    puts $f hello
    set l ""
    lappend l [testchannel outputbuffered $f]
    lappend l [tell $f]
    flush $f
    lappend l [testchannel outputbuffered $f]
    lappend l [tell $f]
    close $f
    removeFile test1
    set l
} {6 6 0 6}

# Test flushing. The functions tested here are FlushChannel.

test io-4.1 {FlushChannel, no output buffered} {
    removeFile test1
    set f [open test1 w]
    flush $f
    set s [file size test1]
    close $f
    set s
} 0
test io-4.2 {FlushChannel, some output buffered} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf -eofchar {}
    set l ""
    puts $f hello
    lappend l [file size test1]
    flush $f
    lappend l [file size test1]
    close $f
    lappend l [file size test1]
    set l
} {0 6 6}
test io-4.3 {FlushChannel, implicit flush on close} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf -eofchar {}
    set l ""
    puts $f hello
    lappend l [file size test1]
    close $f
    lappend l [file size test1]
    set l
} {0 6}
test io-4.4 {FlushChannel, implicit flush when buffer fills} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf -eofchar {}
    fconfigure $f -buffersize 60
    set l ""
    lappend l [file size test1]
    for {set i 0} {$i < 12} {incr i} {
	puts $f hello
    }
    lappend l [file size test1]
    flush $f
    lappend l [file size test1]
    close $f
    set l
} {0 60 72}
test io-4.5 {FlushChannel, implicit flush when buffer fills and on close} {unixOrPc} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf -buffersize 60 -eofchar {}
    set l ""
    lappend l [file size test1]
    for {set i 0} {$i < 12} {incr i} {
	puts $f hello
    }