io.test

linux系统下的音频通信

    lappend l [file size test1]
    close $f
    lappend l [file size test1]
    set l
} {0 60 72}
test io-4.6 {FlushChannel, async flushing, async close} {stdio && asyncPipeClose} {
    removeFile pipe
    removeFile output
    set f [open pipe w]
    puts $f {
	set f [open output w]
	fconfigure $f -translation lf -buffering none -eofchar {}
	while {![eof stdin]} {
	    after 20
	    puts -nonewline $f [read stdin 1024]
	}
	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]" w]
    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

# Tests closing a channel. The functions tested are CloseChannel and Tcl_Close.

test io-5.1 {CloseChannel called when all references are dropped} {
    removeFile test1
    set f [open test1 w]
    interp create x
    interp share "" $f x
    set l ""
    lappend l [testchannel refcount $f]
    x eval close $f
    interp delete x
    lappend l [testchannel refcount $f]
    close $f
    set l
} {2 1}
test io-5.2 {CloseChannel called when all references are dropped} {
    removeFile test1
    set f [open test1 w]
    interp create x
    interp share "" $f x
    puts -nonewline $f abc
    close $f
    x eval puts $f def
    x eval close $f
    interp delete x
    set f [open test1 r]
    set l [gets $f]
    close $f
    set l
} abcdef
test io-5.3 {CloseChannel, not called before output queue is empty} {unixOrPc asyncPipeClose nonPortable tempNotPc} {
    removeFile pipe
    removeFile output
    set f [open pipe w]
    puts $f {

	# Need to not have eof char appended on close, because the other
	# side of the pipe already closed, so that writing would cause an
	# error "invalid file".

	fconfigure stdout -eofchar {}
	fconfigure stderr -eofchar {}

	set f [open output w]
	fconfigure $f -translation lf -buffering none
	for {set x 0} {$x < 20} {incr x} {
	    after 20
	    puts -nonewline $f [read stdin 1024]
	}
	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 -eofchar {}

    # Under windows, the first 24576 bytes of $x are copied to $f, and
    # then the writing fails.  

    puts -nonewline $f $x
    close $f
    set counter 0
    while {([file size output] < 20480) && ($counter < 1000)} {
        incr counter
        after 20
        update
    }
    if {$counter == 1000} {
        set result probably_broken
    } else {
        set result ok
    }
} ok
test io-5.4 {Tcl_Close} {
    removeFile test1
    set l ""
    lappend l [lsort [testchannel open]]
    set f [open test1 w]
    lappend l [lsort [testchannel open]]
    close $f
    lappend l [lsort [testchannel open]]
    set x [list $consoleFileNames \
		[lsort [eval list $consoleFileNames $f]] \
		$consoleFileNames]
    string compare $l $x
} 0
test io-5.5 {Tcl_Close vs standard handles} {unixOnly} {
    removeFile script
    set f [open script w]
    puts $f {
	close stdin
	puts [testchannel open]
    }
    close $f
    set f [open "|[list $tcltest script]" r]
    set l [gets $f]
    close $f
    set l
} {file1 file2}

# Test output on channels. The functions tested are Tcl_Write
# and Tcl_Flush.

test io-6.1 {Tcl_Write, channel not writable} {
    list [catch {puts stdin hello} msg] $msg
} {1 {channel "stdin" wasn't opened for writing}}
test io-6.2 {Tcl_Write, empty string} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -eofchar {}
    puts -nonewline $f ""
    close $f
    file size test1
} 0
test io-6.3 {Tcl_Write, nonempty string} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -eofchar {}
    puts -nonewline $f hello
    close $f
    file size test1
} 5
test io-6.4 {Tcl_Write, buffering in full buffering mode} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf -buffering full -eofchar {}
    puts $f hello
    set l ""
    lappend l [testchannel outputbuffered $f]
    lappend l [file size test1]
    flush $f
    lappend l [testchannel outputbuffered $f]
    lappend l [file size test1]
    close $f
    set l
} {6 0 0 6}
test io-6.5 {Tcl_Write, buffering in line buffering mode} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf -buffering line -eofchar {}
    puts -nonewline $f hello
    set l ""
    lappend l [testchannel outputbuffered $f]
    lappend l [file size test1]
    puts $f hello
    lappend l [testchannel outputbuffered $f]
    lappend l [file size test1]
    close $f
    set l
} {5 0 0 11}
test io-6.6 {Tcl_Write, buffering in no buffering mode} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf -buffering none -eofchar {}
    puts -nonewline $f hello
    set l ""
    lappend l [testchannel outputbuffered $f]
    lappend l [file size test1]
    puts $f hello
    lappend l [testchannel outputbuffered $f]
    lappend l [file size test1]
    close $f
    set l
} {0 5 0 11}
test io-6.7 {Tcl_Flush, full buffering} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf -buffering full -eofchar {}
    puts -nonewline $f hello
    set l ""
    lappend l [testchannel outputbuffered $f]
    lappend l [file size test1]
    puts $f hello
    lappend l [testchannel outputbuffered $f]
    lappend l [file size test1]
    flush $f
    lappend l [testchannel outputbuffered $f]
    lappend l [file size test1]
    close $f
    set l
} {5 0 11 0 0 11}
test io-6.8 {Tcl_Flush, full buffering} {
    removeFile test1
    set f [open test1 w]
    fconfigure $f -translation lf -buffering line
    puts -nonewline $f hello
    set l ""
    lappend l [testchannel outputbuffered $f]
    lappend l [file size test1]
    flush $f
    lappend l [testchannel outputbuffered $f]
    lappend l [file size test1]
    puts $f hello
    lappend l [testchannel outputbuffered $f]
    lappend l [file size test1]
    flush $f
    lappend l [testchannel outputbuffered $f]
    lappend l [file size test1]
    close $f
    set l
} {5 0 0 5 0 11 0 11}
test io-6.9 {Tcl_Flush, channel not writable} {
    list [catch {flush stdin} msg] $msg
} {1 {channel "stdin" wasn't opened for writing}}
test io-6.10 {Tcl_Write, looping and buffering} {
    removeFile test1
    set f1 [open test1 w]
    fconfigure $f1 -translation lf -eofchar {}
    set f2 [open longfile r]
    for {set x 0} {$x < 10} {incr x} {
        puts $f1 [gets $f2]
    }
    close $f2
    close $f1
    file size test1
} 387
test io-6.11 {Tcl_Write, no newline, implicit flush} {
    removeFile test1
    set f1 [open test1 w]
    fconfigure $f1 -eofchar {}
    set f2 [open longfile r]
    for {set x 0} {$x < 10} {incr x} {
        puts -nonewline $f1 [gets $f2]
    }
    close $f1
    close $f2
    file size test1
} 377
test io-6.12 {Tcl_Write on a pipe} {stdio} {
    removeFile test1
    removeFile pipe
    set f1 [open pipe w]
    puts $f1 {
	set f1 [open longfile r]
	for {set x 0} {$x < 10} {incr x} {
	    puts [gets $f1]
	}
    }
    close $f1
    set f1 [open "|[list $tcltest pipe]" r]
    set f2 [open longfile r]
    set y ok
    for {set x 0} {$x < 10} {incr x} {
        set l1 [gets $f1]
        set l2 [gets $f2]
        if {"$l1" != "$l2"} {
            set y broken
        }
    }
    close $f1
    close $f2
    set y
} ok
test io-6.13 {Tcl_Write to a pipe, line buffered} {stdio} {
    removeFile test1
    removeFile pipe
    set f1 [open pipe w]
    puts $f1 {
	puts [gets stdin]
	puts [gets stdin]
    }
    close $f1
    set y ok
    set f1 [open "|[list $tcltest pipe]" r+]
    fconfigure $f1 -buffering line
    set f2 [open longfile r]
    set line [gets $f2]
    puts $f1 $line
    set backline [gets $f1]
    if {"$line" != "$backline"} {
        set y broken
    }
    set line [gets $f2]
    puts $f1 $line
    set backline [gets $f1]
    if {"$line" != "$backline"} {
        set y broken
    }
    close $f1
    close $f2
    set y
} ok
test io-6.14 {Tcl_Write, buffering and implicit flush at close} {
    removeFile test3
    set f [open test3 w]
    puts -nonewline $f "Text1"
    puts -nonewline $f " Text 2"
    puts $f " Text 3"
    close $f
    set f [open test3 r]
    set x [gets $f]
    close $f
    set x
} {Text1 Text 2 Text 3}
test io-6.15 {Tcl_Flush, channel not open for writing} {
    removeFile test1
    set fd [open test1 w]
    close $fd
    set fd [open test1 r]
    set x [list [catch {flush $fd} msg] $msg]
    close $fd
    string compare $x \
	[list 1 "channel \"$fd\" wasn't opened for writing"]
} 0
test io-6.16 {Tcl_Flush on pipe opened only for reading} {stdio} {
    set fd [open "|[list $tcltest cat longfile]" r]
    set x [list [catch {flush $fd} msg] $msg]
    catch {close $fd}
    string compare $x \
	[list 1 "channel \"$fd\" wasn't opened for writing"]
} 0
test io-6.17 {Tcl_Write buffers, then Tcl_Flush flushes} {
    removeFile test1
    set f1 [open test1 w]
    fconfigure $f1 -translation lf
    puts $f1 hello
    puts $f1 hello
    puts $f1 hello
    flush $f1
    set x [file size test1]
    close $f1
    set x
} 18
test io-6.18 {Tcl_Write and Tcl_Flush intermixed} {
    removeFile test1
    set x ""
    set f1 [open test1 w]
    fconfigure $f1 -translation lf
    puts $f1 hello
    puts $f1 hello
    puts $f1 hello
    flush $f1
    lappend x [file size test1]
    puts $f1 hello
    flush $f1
    lappend x [file size test1]
    puts $f1 hello
    flush $f1
    lappend x [file size test1]
    close $f1
    set x
} {18 24 30}
test io-6.19 {Explicit and implicit flushes} {
    removeFile test1
    set f1 [open test1 w]
    fconfigure $f1 -translation lf -eofchar {}
    set x ""
    puts $f1 hello
    puts $f1 hello
    puts $f1 hello
    flush $f1
    lappend x [file size test1]
    puts $f1 hello
    flush $f1
    lappend x [file size test1]
    puts $f1 hello
    close $f1
    lappend x [file size test1]
    set x
} {18 24 30}
test io-6.20 {Implicit flush when buffer is full} {
    removeFile test1
    set f1 [open test1 w]
    fconfigure $f1 -translation lf -eofchar {}
    set line "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
    for {set x 0} {$x < 100} {incr x} {
      puts $f1 $line
    }
    set z ""
    lappend z [file size test1]
    for {set x 0} {$x < 100} {incr x} {
        puts $f1 $line
    }
    lappend z [file size test1]
    close $f1
    lappend z [file size test1]
    set z
} {4096 12288 12600}
test io-6.21 {Tcl_Flush to pipe} {stdio} {
    removeFile pipe
    set f1 [open pipe w]
    puts $f1 {set x [read stdin 6]}
    puts $f1 {set cnt [string length $x]}
    puts $f1 {puts "read $cnt characters"}
    close $f1
    set f1 [open "|[list $tcltest pipe]" r+]
    puts $f1 hello
    flush $f1
    set x [gets $f1]
    catch {close $f1}
    set x
} "read 6 characters"
test io-6.22 {Tcl_Flush called at other end of pipe} {stdio} {
    removeFile pipe
    set f1 [open pipe w]
    puts $f1 {
	fconfigure stdout -buffering full
	puts hello
	puts hello
	flush stdout
	gets stdin
	puts bye
	flush stdout
    }
    close $f1
    set f1 [open "|[list $tcltest pipe]" r+]
    set x ""
    lappend x [gets $f1]
    lappend x [gets $f1]
    puts $f1 hello
    flush $f1
    lappend x [gets $f1]
    close $f1
    set x
} {hello hello bye}
test io-6.23 {Tcl_Flush and line buffering at end of pipe} {stdio} {
    removeFile pipe
    set f1 [open pipe w]
    puts $f1 {
	puts hello
	puts hello
	gets stdin
	puts bye
    }
    close $f1
    set f1 [open "|[list $tcltest pipe]" r+]
    set x ""
    lappend x [gets $f1]
    lappend x [gets $f1]
    puts $f1 hello
    flush $f1
    lappend x [gets $f1]
    close $f1
    set x
} {hello hello bye}
test io-6.24 {Tcl_Write and Tcl_Flush move end of file} {
    set f [open test3 w]
    puts $f "Line 1"
    puts $f "Line 2"
    set f2 [open test3]
    set x {}
    lappend x [read -nonewline $f2]
    close $f2
    flush $f
    set f2 [open test3]
    lappend x [read -nonewline $f2]
    close $f2
    close $f
    set x
} {{} {Line 1
Line 2}}
test io-6.25 {Implicit flush with Tcl_Flush to command pipelines} {stdio} {
    removeFile test3
    set f [open "|[list $tcltest cat | $tcltest cat > test3]" w]
    puts $f "Line 1"
    puts $f "Line 2"
    close $f
    after 100
    set f [open test3 r]
    set x [read $f]
    close $f
    set x
} {Line 1
Line 2
}