io.test

tcl是工具命令语言

    close $f
    set f [open $path(test1)]
    fconfigure $f -eofchar \x1a
    set x [list [gets $f line] $line [gets $f line] $line]
    close $f
    set x
} {11 abcdefghijk 3 wom}

# Comprehensive tests

test io-6.10 {Tcl_GetsObj: lf mode: no chars} {
    set f [open $path(test1) w]
    close $f
    set f [open $path(test1)]
    fconfigure $f -translation lf
    set x [list [gets $f line] $line]
    close $f
    set x
} {-1 {}}
test io-6.11 {Tcl_GetsObj: lf mode: lone \n} {
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    puts -nonewline $f "\n"
    close $f
    set f [open $path(test1)]
    fconfigure $f -translation lf
    set x [list [gets $f line] $line [gets $f line] $line]
    close $f
    set x
} {0 {} -1 {}}
test io-6.12 {Tcl_GetsObj: lf mode: lone \r} {
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    puts -nonewline $f "\r"
    close $f
    set f [open $path(test1)]
    fconfigure $f -translation lf
    set x [list [gets $f line] $line [gets $f line] $line]
    close $f
    set x
} [list 1 "\r" -1 ""]
test io-6.13 {Tcl_GetsObj: lf mode: 1 char} {
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    puts -nonewline $f a
    close $f
    set f [open $path(test1)]
    fconfigure $f -translation lf
    set x [list [gets $f line] $line [gets $f line] $line]
    close $f
    set x
} {1 a -1 {}}
test io-6.14 {Tcl_GetsObj: lf mode: 1 char followed by EOL} {
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    puts -nonewline $f "a\n"
    close $f
    set f [open $path(test1)]
    fconfigure $f -translation lf
    set x [list [gets $f line] $line [gets $f line] $line]
    close $f
    set x
} {1 a -1 {}}
test io-6.15 {Tcl_GetsObj: lf mode: several chars} {
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    puts -nonewline $f "abcd\nefgh\rijkl\r\nmnop"
    close $f
    set f [open $path(test1)]
    fconfigure $f -translation lf
    set x [list [gets $f line] $line [gets $f line] $line [gets $f line] $line [gets $f line] $line]
    close $f
    set x
} [list 4 "abcd" 10 "efgh\rijkl\r" 4 "mnop" -1 ""]
test io-6.16 {Tcl_GetsObj: cr mode: no chars} {
    set f [open $path(test1) w]
    close $f
    set f [open $path(test1)]
    fconfigure $f -translation cr
    set x [list [gets $f line] $line]
    close $f
    set x
} {-1 {}}
test io-6.17 {Tcl_GetsObj: cr mode: lone \n} {
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    puts -nonewline $f "\n"
    close $f
    set f [open $path(test1)]
    fconfigure $f -translation cr
    set x [list [gets $f line] $line [gets $f line] $line]
    close $f
    set x
} [list 1 "\n" -1 ""]
test io-6.18 {Tcl_GetsObj: cr mode: lone \r} {
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    puts -nonewline $f "\r"
    close $f
    set f [open $path(test1)]
    fconfigure $f -translation cr
    set x [list [gets $f line] $line [gets $f line] $line]
    close $f
    set x
} {0 {} -1 {}}
test io-6.19 {Tcl_GetsObj: cr mode: 1 char} {
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    puts -nonewline $f a
    close $f
    set f [open $path(test1)]
    fconfigure $f -translation cr
    set x [list [gets $f line] $line [gets $f line] $line]
    close $f
    set x
} {1 a -1 {}}
test io-6.20 {Tcl_GetsObj: cr mode: 1 char followed by EOL} {
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    puts -nonewline $f "a\r"
    close $f
    set f [open $path(test1)]
    fconfigure $f -translation cr
    set x [list [gets $f line] $line [gets $f line] $line]
    close $f
    set x
} {1 a -1 {}}
test io-6.21 {Tcl_GetsObj: cr mode: several chars} {
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    puts -nonewline $f "abcd\nefgh\rijkl\r\nmnop"
    close $f
    set f [open $path(test1)]
    fconfigure $f -translation cr
    set x [list [gets $f line] $line [gets $f line] $line [gets $f line] $line [gets $f line] $line]
    close $f
    set x
} [list 9 "abcd\nefgh" 4 "ijkl" 5 "\nmnop" -1 ""]
test io-6.22 {Tcl_GetsObj: crlf mode: no chars} {
    set f [open $path(test1) w]
    close $f
    set f [open $path(test1)]
    fconfigure $f -translation crlf
    set x [list [gets $f line] $line]
    close $f
    set x
} {-1 {}}
test io-6.23 {Tcl_GetsObj: crlf mode: lone \n} {
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    puts -nonewline $f "\n"
    close $f
    set f [open $path(test1)]
    fconfigure $f -translation crlf
    set x [list [gets $f line] $line [gets $f line] $line]
    close $f
    set x
} [list 1 "\n" -1 ""]
test io-6.24 {Tcl_GetsObj: crlf mode: lone \r} {
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    puts -nonewline $f "\r"
    close $f
    set f [open $path(test1)]
    fconfigure $f -translation crlf
    set x [list [gets $f line] $line [gets $f line] $line]
    close $f
    set x
} [list 1 "\r" -1 ""]
test io-6.25 {Tcl_GetsObj: crlf mode: \r\r} {
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    puts -nonewline $f "\r\r"
    close $f
    set f [open $path(test1)]
    fconfigure $f -translation crlf
    set x [list [gets $f line] $line [gets $f line] $line]
    close $f
    set x
} [list 2 "\r\r" -1 ""]
test io-6.26 {Tcl_GetsObj: crlf mode: \r\n} {
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    puts -nonewline $f "\r\n"
    close $f
    set f [open $path(test1)]
    fconfigure $f -translation crlf
    set x [list [gets $f line] $line [gets $f line] $line]
    close $f
    set x
} [list 0 "" -1 ""]
test io-6.27 {Tcl_GetsObj: crlf mode: 1 char} {
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    puts -nonewline $f a
    close $f
    set f [open $path(test1)]
    fconfigure $f -translation crlf
    set x [list [gets $f line] $line [gets $f line] $line]
    close $f
    set x
} {1 a -1 {}}
test io-6.28 {Tcl_GetsObj: crlf mode: 1 char followed by EOL} {
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    puts -nonewline $f "a\r\n"
    close $f
    set f [open $path(test1)]
    fconfigure $f -translation crlf
    set x [list [gets $f line] $line [gets $f line] $line]
    close $f
    set x
} {1 a -1 {}}
test io-6.29 {Tcl_GetsObj: crlf mode: several chars} {
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    puts -nonewline $f "abcd\nefgh\rijkl\r\nmnop"
    close $f
    set f [open $path(test1)]
    fconfigure $f -translation crlf
    set x [list [gets $f line] $line [gets $f line] $line [gets $f line] $line]
    close $f
    set x
} [list 14 "abcd\nefgh\rijkl" 4 "mnop" -1 ""]
test io-6.30 {Tcl_GetsObj: crlf mode: buffer exhausted} {testchannel} {
    # if (eol >= dstEnd)

    set f [open $path(test1) w]
    fconfigure $f -translation lf
    puts -nonewline $f "123456789012345\r\nabcdefghijklmnoprstuvwxyz"
    close $f
    set f [open $path(test1)]
    fconfigure $f -translation crlf -buffersize 16
    set x [list [gets $f line] $line [testchannel inputbuffered $f]]
    close $f
    set x
} [list 15 "123456789012345" 15]
test io-6.31 {Tcl_GetsObj: crlf mode: buffer exhausted, blocked} {stdio testchannel} {
    # (FilterInputBytes() != 0)

    set f [open "|[list [interpreter] $path(cat)]" w+]
    fconfigure $f -translation {crlf lf} -buffering none
    puts -nonewline $f "bbbbbbbbbbbbbb\r\n123456789012345\r"
    fconfigure $f -buffersize 16
    set x [gets $f]
    fconfigure $f -blocking 0
    lappend x [gets $f line] $line [fblocked $f] [testchannel inputbuffered $f]
    close $f
    set x
} [list "bbbbbbbbbbbbbb" -1 "" 1 16]
test io-6.32 {Tcl_GetsObj: crlf mode: buffer exhausted, more data} {testchannel} {
    # not (FilterInputBytes() != 0)

    set f [open $path(test1) w]
    fconfigure $f -translation lf
    puts -nonewline $f "123456789012345\r\n123"
    close $f
    set f [open $path(test1)]
    fconfigure $f -translation crlf -buffersize 16
    set x [list [gets $f line] $line [tell $f] [testchannel inputbuffered $f]]
    close $f
    set x
} [list 15 "123456789012345" 17 3]
test io-6.33 {Tcl_GetsObj: crlf mode: buffer exhausted, at eof} {
    # eol still equals dstEnd
    
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    puts -nonewline $f "123456789012345\r"
    close $f
    set f [open $path(test1)]
    fconfigure $f -translation crlf -buffersize 16
    set x [list [gets $f line] $line [eof $f]]
    close $f
    set x
} [list 16 "123456789012345\r" 1]
test io-6.34 {Tcl_GetsObj: crlf mode: buffer exhausted, not followed by \n} {
    # not (*eol == '\n') 
    
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    puts -nonewline $f "123456789012345\rabcd\r\nefg"
    close $f
    set f [open $path(test1)]
    fconfigure $f -translation crlf -buffersize 16
    set x [list [gets $f line] $line [tell $f]]
    close $f
    set x
} [list 20 "123456789012345\rabcd" 22]
test io-6.35 {Tcl_GetsObj: auto mode: no chars} {
    set f [open $path(test1) w]
    close $f
    set f [open $path(test1)]
    fconfigure $f -translation auto
    set x [list [gets $f line] $line]
    close $f
    set x
} {-1 {}}
test io-6.36 {Tcl_GetsObj: auto mode: lone \n} {
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    puts -nonewline $f "\n"
    close $f
    set f [open $path(test1)]
    fconfigure $f -translation auto
    set x [list [gets $f line] $line [gets $f line] $line]
    close $f
    set x
} [list 0 "" -1 ""]
test io-6.37 {Tcl_GetsObj: auto mode: lone \r} {
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    puts -nonewline $f "\r"
    close $f
    set f [open $path(test1)]
    fconfigure $f -translation auto
    set x [list [gets $f line] $line [gets $f line] $line]
    close $f
    set x
} [list 0 "" -1 ""]
test io-6.38 {Tcl_GetsObj: auto mode: \r\r} {
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    puts -nonewline $f "\r\r"
    close $f
    set f [open $path(test1)]
    fconfigure $f -translation auto
    set x [list [gets $f line] $line [gets $f line] $line [gets $f line] $line]
    close $f
    set x
} [list 0 "" 0 "" -1 ""]
test io-6.39 {Tcl_GetsObj: auto mode: \r\n} {
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    puts -nonewline $f "\r\n"
    close $f
    set f [open $path(test1)]
    fconfigure $f -translation auto
    set x [list [gets $f line] $line [gets $f line] $line]
    close $f
    set x
} [list 0 "" -1 ""]
test io-6.40 {Tcl_GetsObj: auto mode: 1 char} {
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    puts -nonewline $f a
    close $f
    set f [open $path(test1)]
    fconfigure $f -translation auto
    set x [list [gets $f line] $line [gets $f line] $line]
    close $f
    set x
} {1 a -1 {}}
test io-6.41 {Tcl_GetsObj: auto mode: 1 char followed by EOL} {
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    puts -nonewline $f "a\r\n"
    close $f
    set f [open $path(test1)]
    fconfigure $f -translation auto
    set x [list [gets $f line] $line [gets $f line] $line]
    close $f
    set x
} {1 a -1 {}}
test io-6.42 {Tcl_GetsObj: auto mode: several chars} {
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    puts -nonewline $f "abcd\nefgh\rijkl\r\nmnop"
    close $f
    set f [open $path(test1)]
    fconfigure $f -translation auto
    set x [list [gets $f line] $line [gets $f line] $line]
    lappend x [gets $f line] $line [gets $f line] $line [gets $f line] $line
    close $f
    set x
} [list 4 "abcd" 4 "efgh" 4 "ijkl" 4 "mnop" -1 ""]
test io-6.43 {Tcl_GetsObj: input saw cr} {stdio testchannel} {
    # if (chanPtr->flags & INPUT_SAW_CR)

    set f [open "|[list [interpreter] $path(cat)]" w+]
    fconfigure $f -translation {auto lf} -buffering none
    puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
    fconfigure $f -buffersize 16
    set x [list [gets $f]]
    fconfigure $f -blocking 0
    lappend x [gets $f line] $line [testchannel queuedcr $f] 
    fconfigure $f -blocking 1
    puts -nonewline $f "\nabcd\refg\x1a"
    lappend x [gets $f line] $line [testchannel queuedcr $f]
    lappend x [gets $f line] $line
    close $f
    set x
} [list "bbbbbbbbbbbbbbb" 15 "123456789abcdef" 1 4 "abcd" 0 3 "efg"]
test io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} {stdio testchannel} {
    # not (*eol == '\n') 

    set f [open "|[list [interpreter] $path(cat)]" w+]
    fconfigure $f -translation {auto lf} -buffering none
    puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
    fconfigure $f -buffersize 16
    set x [list [gets $f]]
    fconfigure $f -blocking 0
    lappend x [gets $f line] $line [testchannel queuedcr $f] 
    fconfigure $f -blocking 1
    puts -nonewline $f "abcd\refg\x1a"
    lappend x [gets $f line] $line [testchannel queuedcr $f]
    lappend x [gets $f line] $line
    close $f
    set x
} [list "bbbbbbbbbbbbbbb" 15 "123456789abcdef" 1 4 "abcd" 0 3 "efg"]
test io-6.45 {Tcl_GetsObj: input saw cr, skip right number of bytes} {stdio testchannel} {
    # Tcl_ExternalToUtf()

    set f [open "|[list [interpreter] $path(cat)]" w+]
    fconfigure $f -translation {auto lf} -buffering none
    fconfigure $f -encoding unicode
    puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
    fconfigure $f -buffersize 16
    gets $f
    fconfigure $f -blocking 0
    set x [list [gets $f line] $line [testchannel queuedcr $f]]
    fconfigure $f -blocking 1
    puts -nonewline $f "\nabcd\refg"
    lappend x [gets $f line] $line [testchannel queuedcr $f]
    close $f
    set x
} [list 15 "123456789abcdef" 1 4 "abcd" 0]
test io-6.46 {Tcl_GetsObj: input saw cr, followed by just \n should give eof} {stdio testchannel} {
    # memmove()

    set f [open "|[list [interpreter] $path(cat)]" w+]
    fconfigure $f -translation {auto lf} -buffering none
    puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
    fconfigure $f -buffersize 16