io.test

linux系统下的音频通信

test io-6.26 {Tcl_Flush, Tcl_Write on bidirectional pipelines} {unixOrPc && unixExecs && tempNotPc} {
    set f [open "|[list cat -u]" r+]
    puts $f "Line1"
    flush $f
    set x [gets $f]
    close $f
    set x
} {Line1}
test io-6.27 {Tcl_Flush on closed pipeline} {stdio && tempNotPc} {
    removeFile pipe
    set f [open pipe w]
    puts $f {exit}
    close $f
    set f [open "|[list $tcltest pipe]" r+]
    gets $f
    puts $f output
    after 50
    #
    # The flush below will get a SIGPIPE. This is an expected part of
    # test and indicates that the test operates correctly. If you run
    # this test under a debugger, the signal will by intercepted unless
    # you disable the debugger's signal interception.
    #
    if {[catch {flush $f} msg]} {
	set x [list 1 $msg $errorCode]
	catch {close $f}
    } else {
	if {[catch {close $f} msg]} {
	    set x [list 1 $msg $errorCode]
	} else {
	    set x {this was supposed to fail and did not}
	}
    }
    regsub {".*":} $x {"":} x
    string tolower $x
} {1 {error flushing "": broken pipe} {posix epipe {broken pipe}}}
test io-6.28 {Tcl_Write, lf mode} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf -eofchar {}
    puts $f hello\nthere\nand\nhere
    flush $f
    set s [file size test1]
    close $f
    set s
} 21
test io-6.29 {Tcl_Write, cr mode} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation cr -eofchar {}
    puts $f hello\nthere\nand\nhere
    close $f
    file size test1
} 21
test io-6.30 {Tcl_Write, crlf mode} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation crlf -eofchar {}
    puts $f hello\nthere\nand\nhere
    close $f
    file size test1
} 25
test io-6.31 {Tcl_Write, background flush} {stdio} {
    removeFile pipe
    removeFile output
    set f [open pipe w]
    puts $f {set f [open output w]}
    puts $f {fconfigure $f -translation lf}
    set x [list while {![eof stdin]}]
    set x "$x {"
    puts $f $x
    puts $f {  puts -nonewline $f [read stdin 4096]}
    puts $f {  flush $f}
    puts $f "}"
    puts $f {close $f}
    close $f
    set x 01234567890123456789012345678901
    for {set i 0} {$i < 11} {incr i} {
        set x "$x$x"
    }
    set f [open output w]
    close $f
    set f [open "|[list $tcltest pipe]" r+]
    fconfigure $f -blocking off
    puts -nonewline $f $x
    close $f
    set counter 0
    while {([file size output] < 65536) && ($counter < 1000)} {
        incr counter
        after 5
        update
    }
    if {$counter == 1000} {
        set result probably_broken
    } else {
        set result ok
    }
} ok
test io-6.32 {Tcl_Write, background flush to slow reader} {stdio && asyncPipeClose} {
    removeFile pipe
    removeFile output
    set f [open pipe w]
    puts $f {set f [open output w]}
    puts $f {fconfigure $f -translation lf}
    set x [list while {![eof stdin]}]
    set x "$x {"
    puts $f $x
    puts $f {  after 20}
    puts $f {  puts -nonewline $f [read stdin 1024]}
    puts $f {  flush $f}
    puts $f "}"
    puts $f {close $f}
    close $f
    set x 01234567890123456789012345678901
    for {set i 0} {$i < 11} {incr i} {
        set x "$x$x"
    }
    set f [open output w]
    close $f
    set f [open "|[list $tcltest pipe]" r+]
    fconfigure $f -blocking off
    puts -nonewline $f $x
    close $f
    set counter 0
    while {([file size output] < 65536) && ($counter < 1000)} {
        incr counter
        after 20
        update
    }
    if {$counter == 1000} {
        set result probably_broken
    } else {
        set result ok
    }
} ok
test io-6.33 {Tcl_Flush, implicit flush on exit} {stdio} {
    set f [open script w]
    puts $f {
	set f [open test1 w]
	fconfigure $f -translation lf
	puts $f hello
	puts $f bye
	puts $f strange
    }
    close $f
    exec $tcltest script
    set f [open test1 r]
    set r [read $f]
    close $f
    set r
} {hello
bye
strange
}

test io-6.34 {Tcl_Close, async flush on close, using sockets} {socket tempNotMac} {
    set c 0
    set x running
    set l abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz
    proc writelots {s l} {
	for {set i 0} {$i < 2000} {incr i} {
	    puts $s $l
	}
    }
    proc accept {s a p} {
	global x
	fileevent $s readable [list readit $s]
	fconfigure $s -blocking off
	set x accepted
    }
    proc readit {s} {
	global c x
	set l [gets $s]
	
	if {[eof $s]} {
	    close $s
	    set x done
	} elseif {([string length $l] > 0) || ![fblocked $s]} {
	    incr c
	}
    }
    set ss [socket -server accept 2828]
    set cs [socket [info hostname] 2828]
    vwait x
    fconfigure $cs -blocking off
    writelots $cs $l
    close $cs
    close $ss
    vwait x
    set c
} 2000
test io-6.35 {Tcl_Close vs fileevent vs multiple interpreters} {socket} {
    catch {interp delete x}
    catch {interp delete y}
    interp create x
    interp create y
    set s [socket -server accept 2828]
    proc accept {s a p} {
	puts $s hello
	close $s
    }
    set c [socket [info hostname] 2828]
    interp share {} $c x
    interp share {} $c y
    close $c
    x eval {
	proc readit {s} {
	    gets $s
	    if {[eof $s]} {
		close $s
	    }
	}
    }
    y eval {
	proc readit {s} {
	    gets $s
	    if {[eof $s]} {
		close $s
	    }
	}
    }
    x eval "fileevent $c readable \{readit $c\}"
    y eval "fileevent $c readable \{readit $c\}"
    y eval [list close $c]
    update
    close $s
    interp delete x
    interp delete y
} ""

# Test end of line translations. Procedures tested are Tcl_Write, Tcl_Read.

test io-7.1 {Tcl_Write lf, Tcl_Read lf} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf
    puts $f hello\nthere\nand\nhere
    close $f
    set f [open test1 r]
    fconfigure $f -translation lf
    set x [read $f]
    close $f
    set x
} "hello\nthere\nand\nhere\n"
test io-7.2 {Tcl_Write lf, Tcl_Read cr} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf
    puts $f hello\nthere\nand\nhere
    close $f
    set f [open test1 r]
    fconfigure $f -translation cr
    set x [read $f]
    close $f
    set x
} "hello\nthere\nand\nhere\n"
test io-7.3 {Tcl_Write lf, Tcl_Read crlf} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf
    puts $f hello\nthere\nand\nhere
    close $f
    set f [open test1 r]
    fconfigure $f -translation crlf
    set x [read $f]
    close $f
    set x
} "hello\nthere\nand\nhere\n"
test io-7.4 {Tcl_Write cr, Tcl_Read cr} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation cr
    puts $f hello\nthere\nand\nhere
    close $f
    set f [open test1 r]
    fconfigure $f -translation cr
    set x [read $f]
    close $f
    set x
} "hello\nthere\nand\nhere\n"
test io-7.5 {Tcl_Write cr, Tcl_Read lf} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation cr
    puts $f hello\nthere\nand\nhere
    close $f
    set f [open test1 r]
    fconfigure $f -translation lf
    set x [read $f]
    close $f
    set x
} "hello\rthere\rand\rhere\r"
test io-7.6 {Tcl_Write cr, Tcl_Read crlf} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation cr
    puts $f hello\nthere\nand\nhere
    close $f
    set f [open test1 r]
    fconfigure $f -translation crlf
    set x [read $f]
    close $f
    set x 
} "hello\rthere\rand\rhere\r"
test io-7.7 {Tcl_Write crlf, Tcl_Read crlf} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation crlf
    puts $f hello\nthere\nand\nhere
    close $f
    set f [open test1 r]
    fconfigure $f -translation crlf
    set x [read $f]
    close $f
    set x
} "hello\nthere\nand\nhere\n"
test io-7.8 {Tcl_Write crlf, Tcl_Read lf} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation crlf
    puts $f hello\nthere\nand\nhere
    close $f
    set f [open test1 r]
    fconfigure $f -translation lf
    set x [read $f]
    close $f
    set x
} "hello\r\nthere\r\nand\r\nhere\r\n"
test io-7.9 {Tcl_Write crlf, Tcl_Read cr} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation crlf
    puts $f hello\nthere\nand\nhere
    close $f
    set f [open test1 r]
    fconfigure $f -translation cr
    set x [read $f]
    close $f
    set x
} "hello\n\nthere\n\nand\n\nhere\n\n"
test io-7.10 {Tcl_Write lf, Tcl_Read auto} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf
    puts $f hello\nthere\nand\nhere
    close $f
    set f [open test1 r]
    set c [read $f]
    set x [fconfigure $f -translation]
    close $f
    list $c $x
} {{hello
there
and
here
} auto}
test io-7.11 {Tcl_Write cr, Tcl_Read auto} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation cr
    puts $f hello\nthere\nand\nhere
    close $f
    set f [open test1 r]
    set c [read $f]
    set x [fconfigure $f -translation]
    close $f
    list $c $x
} {{hello
there
and
here
} auto}
test io-7.12 {Tcl_Write crlf, Tcl_Read auto} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation crlf
    puts $f hello\nthere\nand\nhere
    close $f
    set f [open test1 r]
    set c [read $f]
    set x [fconfigure $f -translation]
    close $f
    list $c $x
} {{hello
there
and
here
} auto}

test io-7.13 {Tcl_Write crlf on block boundary, Tcl_Read auto} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation crlf
    set line "123456789ABCDE"	;# 14 char plus crlf
    puts -nonewline $f x	;# shift crlf across block boundary
    for {set i 0} {$i < 700} {incr i} {
	puts $f $line
    }
    close $f
    set f [open test1 r]
    fconfigure $f -translation auto
    set c [read $f]
    close $f
    string length $c
} [expr 700*15+1]

test io-7.14 {Tcl_Write crlf on block boundary, Tcl_Read crlf} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation crlf
    set line "123456789ABCDE"	;# 14 char plus crlf
    puts -nonewline $f x	;# shift crlf across block boundary
    for {set i 0} {$i < 700} {incr i} {
	puts $f $line
    }
    close $f
    set f [open test1 r]
    fconfigure $f -translation crlf
    set c [read $f]
    close $f
    string length $c
} [expr 700*15+1]

test io-7.15 {Tcl_Write mixed, Tcl_Read auto} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf
    puts $f hello\nthere\nand\rhere
    close $f
    set f [open test1 r]
    fconfigure $f -translation auto
    set c [read $f]
    close $f
    set c
} {hello
there
and
here
}
test io-7.16 {Tcl_Write ^Z at end, Tcl_Read auto} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf
    puts -nonewline $f hello\nthere\nand\rhere\n\x1a
    close $f
    set f [open test1 r]
    fconfigure $f -eofchar \x1a -translation auto
    set c [read $f]
    close $f
    set c
} {hello
there
and
here
}
test io-7.17 {Tcl_Write, implicit ^Z at end, Tcl_Read auto} {pcOnly} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -eofchar \x1a -translation lf
    puts $f hello\nthere\nand\rhere
    close $f
    set f [open test1 r]
    fconfigure $f -eofchar \x1a -translation auto
    set c [read $f]
    close $f
    set c
} {hello
there
and
here
}
test io-7.18 {Tcl_Write, ^Z in middle, Tcl_Read auto} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf
    set s [format "abc\ndef\n%cghi\nqrs" 26]
    puts $f $s
    close $f
    set f [open test1 r]
    fconfigure $f -eofchar \x1a -translation auto
    set l ""
    lappend l [gets $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    close $f
    set l
} {abc def 0 {} 1 {} 1}
test io-7.19 {Tcl_Write, ^Z no newline in middle, Tcl_Read auto} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf
    set s [format "abc\ndef\n%cghi\nqrs" 26]
    puts $f $s
    close $f
    set f [open test1 r]
    fconfigure $f -eofchar \x1a -translation auto
    set l ""
    lappend l [gets $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    lappend l [gets $f]
    lappend l [eof $f]
    close $f
    set l
} {abc def 0 {} 1 {} 1}
test io-7.20 {Tcl_Write, ^Z in middle ignored, Tcl_Read lf} {