Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | Since -eofchar {} is the default already, no need to specify this over and over again in testcases |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | trunk | main |
Files: | files | file ages | folders |
SHA3-256: |
ee2b3f8f6628e2b1ab613545a5629350 |
User & Date: | jan.nijtmans 2024-06-22 23:29:06 |
Context
2024-06-23
| ||
20:09 | Test cases: no unneccessary "chan configure" statements, remove now obsolete comment check-in: e574afb887 user: jan.nijtmans tags: trunk, main | |
2024-06-22
| ||
23:29 | Since -eofchar {} is the default already, no need to specify this over and over again in testcases check-in: ee2b3f8f66 user: jan.nijtmans tags: trunk, main | |
2024-06-21
| ||
20:37 | Revise use of "-translation binary" in testcases: Use it where usefull, don't use it any more where ... check-in: fafe0d36d9 user: jan.nijtmans tags: trunk, main | |
Changes
Changes to tests/chan.test.
︙ | ︙ | |||
60 61 62 63 64 65 66 | chan configure stdout -eofchar [list \x27 {}] } -result {} test chan-4.5 {chan command: check valid inValue, invalid outValue} -body { chan configure stdout -eofchar [list \x27 \x80] } -returnCodes error -result {bad value for -eofchar: must be non-NUL ASCII character} test chan-4.6 {chan command: check no inValue, valid outValue} -body { chan configure stdout -eofchar [list {} \x27] | | | 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 | chan configure stdout -eofchar [list \x27 {}] } -result {} test chan-4.5 {chan command: check valid inValue, invalid outValue} -body { chan configure stdout -eofchar [list \x27 \x80] } -returnCodes error -result {bad value for -eofchar: must be non-NUL ASCII character} test chan-4.6 {chan command: check no inValue, valid outValue} -body { chan configure stdout -eofchar [list {} \x27] } -returnCodes error -result {bad value for -eofchar: must be non-NUL ASCII character} test chan-5.1 {chan command: copy subcommand} -body { chan copy foo } -returnCodes error -result "wrong # args: should be \"chan copy input output ?-size size? ?-command callback?\"" test chan-6.1 {chan command: eof subcommand} -body { chan eof foo bar |
︙ | ︙ |
Changes to tests/chanio.test.
︙ | ︙ | |||
65 66 67 68 69 70 71 | testConstraint makeFileInHome [expr {![file exists $::env(HOME)/_test_] && [file writable $::env(HOME)]}] # set up a long data file for some of the following tests set path(longfile) [makeFile {} longfile] set f [open $path(longfile) w] | | | 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 | testConstraint makeFileInHome [expr {![file exists $::env(HOME)/_test_] && [file writable $::env(HOME)]}] # set up a long data file for some of the following tests set path(longfile) [makeFile {} longfile] set f [open $path(longfile) w] chan configure $f -translation lf for { set i 0 } { $i < 100 } { incr i} { chan puts $f "#123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef \#123456789abcdef01 \#" } chan close $f |
︙ | ︙ | |||
1949 1950 1951 1952 1953 1954 1955 | chan close $f } -result "file" test chan-io-25.1 {Tcl_GetChannelHandle, input} -setup { set l "" } -constraints {testchannel} -body { set f [open $path(test1) w] | | | 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 | chan close $f } -result "file" test chan-io-25.1 {Tcl_GetChannelHandle, input} -setup { set l "" } -constraints {testchannel} -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts $f "1234567890\n098765432" chan close $f set f [open $path(test1) r] chan gets $f lappend l [testchannel inputbuffered $f] lappend l [chan tell $f] } -cleanup { |
︙ | ︙ | |||
2001 2002 2003 2004 2005 2006 2007 | chan close $f } -result 0 test chan-io-27.2 {FlushChannel, some output buffered} -setup { file delete $path(test1) set l "" } -body { set f [open $path(test1) w] | | | | | | | 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 2028 2029 2030 2031 2032 2033 2034 2035 2036 2037 2038 2039 2040 2041 2042 2043 2044 2045 2046 2047 2048 2049 2050 2051 2052 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 | chan close $f } -result 0 test chan-io-27.2 {FlushChannel, some output buffered} -setup { file delete $path(test1) set l "" } -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts $f hello lappend l [file size $path(test1)] chan flush $f lappend l [file size $path(test1)] chan close $f lappend l [file size $path(test1)] } -result {0 6 6} test chan-io-27.3 {FlushChannel, implicit flush on chan close} -setup { file delete $path(test1) set l "" } -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts $f hello lappend l [file size $path(test1)] chan close $f lappend l [file size $path(test1)] } -result {0 6} test chan-io-27.4 {FlushChannel, implicit flush when buffer fills} -setup { file delete $path(test1) set l "" } -body { set f [open $path(test1) w] chan configure $f -translation lf chan configure $f -buffersize 60 lappend l [file size $path(test1)] for {set i 0} {$i < 12} {incr i} { chan puts $f hello } lappend l [file size $path(test1)] chan flush $f lappend l [file size $path(test1)] } -cleanup { chan close $f } -result {0 60 72} test chan-io-27.5 {FlushChannel, implicit flush when buffer fills and on chan close} -setup { file delete $path(test1) set l "" } -constraints {unixOrWin} -body { set f [open $path(test1) w] chan configure $f -translation lf -buffersize 60 lappend l [file size $path(test1)] for {set i 0} {$i < 12} {incr i} { chan puts $f hello } lappend l [file size $path(test1)] chan close $f lappend l [file size $path(test1)] } -result {0 60 72} set path(pipe) [makeFile {} pipe] set path(output) [makeFile {} output] test chan-io-27.6 {FlushChannel, async flushing, async chan close} -setup { file delete $path(pipe) file delete $path(output) } -constraints {stdio asyncPipeChan Close} -body { set f [open $path(pipe) w] chan puts $f "set f \[[list open $path(output) w]]" chan puts $f { chan configure $f -translation lf -buffering none while {![chan eof stdin]} { after 20 chan puts -nonewline $f [chan read stdin 1024] } chan close $f } chan close $f |
︙ | ︙ | |||
2132 2133 2134 2135 2136 2137 2138 | file delete $path(output) } -constraints {stdio asyncPipeChan Close nonPortable} -body { set f [open $path(pipe) w] chan puts $f { # Need to not have eof char appended on chan close, because the other # side of the pipe already chan closed, so that writing would cause an # error "invalid file". | | | | | 2132 2133 2134 2135 2136 2137 2138 2139 2140 2141 2142 2143 2144 2145 2146 2147 2148 2149 2150 2151 2152 2153 2154 2155 2156 2157 2158 2159 2160 2161 2162 2163 2164 | file delete $path(output) } -constraints {stdio asyncPipeChan Close nonPortable} -body { set f [open $path(pipe) w] chan puts $f { # Need to not have eof char appended on chan close, because the other # side of the pipe already chan closed, so that writing would cause an # error "invalid file". chan configure stdout chan configure stderr set f [open $path(output) w] chan configure $f -translation lf -buffering none for {set x 0} {$x < 20} {incr x} { after 20 chan puts -nonewline $f [chan read stdin 1024] } chan close $f } chan close $f set x 01234567890123456789012345678901 for {set i 0} {$i < 11} {incr i} { set x "$x$x" } set f [open $path(output) w] chan close $f set f [openpipe r+ $path(pipe)] chan configure $f -blocking off chan puts -nonewline $f $x chan close $f set counter 0 while {([file size $path(output)] < 20480) && ($counter < 1000)} { after 20 [list incr [namespace which -variable counter]] vwait [namespace which -variable counter] } |
︙ | ︙ | |||
2267 2268 2269 2270 2271 2272 2273 | test chan-io-29.1 {Tcl_WriteChars, channel not writable} -body { chan puts stdin hello } -returnCodes error -result {channel "stdin" wasn't opened for writing} test chan-io-29.2 {Tcl_WriteChars, empty string} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] | | | | | | | | 2267 2268 2269 2270 2271 2272 2273 2274 2275 2276 2277 2278 2279 2280 2281 2282 2283 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 2333 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 | test chan-io-29.1 {Tcl_WriteChars, channel not writable} -body { chan puts stdin hello } -returnCodes error -result {channel "stdin" wasn't opened for writing} test chan-io-29.2 {Tcl_WriteChars, empty string} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f chan puts -nonewline $f "" chan close $f file size $path(test1) } -result 0 test chan-io-29.3 {Tcl_WriteChars, nonempty string} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f chan puts -nonewline $f hello chan close $f file size $path(test1) } -result 5 test chan-io-29.4 {Tcl_WriteChars, buffering in full buffering mode} -setup { file delete $path(test1) set l "" } -constraints {testchannel} -body { set f [open $path(test1) w] chan configure $f -translation lf -buffering full chan puts $f hello lappend l [testchannel outputbuffered $f] lappend l [file size $path(test1)] chan flush $f lappend l [testchannel outputbuffered $f] lappend l [file size $path(test1)] } -cleanup { chan close $f } -result {6 0 0 6} test chan-io-29.5 {Tcl_WriteChars, buffering in line buffering mode} -setup { file delete $path(test1) set l "" } -constraints {testchannel} -body { set f [open $path(test1) w] chan configure $f -translation lf -buffering line chan puts -nonewline $f hello lappend l [testchannel outputbuffered $f] lappend l [file size $path(test1)] chan puts $f hello lappend l [testchannel outputbuffered $f] lappend l [file size $path(test1)] } -cleanup { chan close $f } -result {5 0 0 11} test chan-io-29.6 {Tcl_WriteChars, buffering in no buffering mode} -setup { file delete $path(test1) set l "" } -constraints {testchannel} -body { set f [open $path(test1) w] chan configure $f -translation lf -buffering none chan puts -nonewline $f hello lappend l [testchannel outputbuffered $f] lappend l [file size $path(test1)] chan puts $f hello lappend l [testchannel outputbuffered $f] lappend l [file size $path(test1)] } -cleanup { chan close $f } -result {0 5 0 11} test chan-io-29.7 {Tcl_Flush, full buffering} -setup { file delete $path(test1) set l "" } -constraints {testchannel} -body { set f [open $path(test1) w] chan configure $f -translation lf -buffering full chan puts -nonewline $f hello lappend l [testchannel outputbuffered $f] lappend l [file size $path(test1)] chan puts $f hello lappend l [testchannel outputbuffered $f] lappend l [file size $path(test1)] chan flush $f |
︙ | ︙ | |||
2372 2373 2374 2375 2376 2377 2378 | test chan-io-29.9 {Tcl_Flush, channel not writable} -body { chan flush stdin } -returnCodes error -result {channel "stdin" wasn't opened for writing} test chan-io-29.10 {Tcl_WriteChars, looping and buffering} -setup { file delete $path(test1) } -body { set f1 [open $path(test1) w] | | | | 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 2382 2383 2384 2385 2386 2387 2388 2389 2390 2391 2392 2393 2394 2395 2396 2397 2398 2399 | test chan-io-29.9 {Tcl_Flush, channel not writable} -body { chan flush stdin } -returnCodes error -result {channel "stdin" wasn't opened for writing} test chan-io-29.10 {Tcl_WriteChars, looping and buffering} -setup { file delete $path(test1) } -body { set f1 [open $path(test1) w] chan configure $f1 -translation lf set f2 [open $path(longfile) r] for {set x 0} {$x < 10} {incr x} { chan puts $f1 [chan gets $f2] } chan close $f2 chan close $f1 file size $path(test1) } -result 387 test chan-io-29.11 {Tcl_WriteChars, no newline, implicit flush} -setup { file delete $path(test1) } -body { set f1 [open $path(test1) w] chan configure $f1 set f2 [open $path(longfile) r] for {set x 0} {$x < 10} {incr x} { chan puts -nonewline $f1 [chan gets $f2] } chan close $f1 chan close $f2 file size $path(test1) |
︙ | ︙ | |||
2519 2520 2521 2522 2523 2524 2525 | } -cleanup { chan close $f1 } -result {18 24 30} test chan-io-29.19 {Explicit and implicit flushes} -setup { file delete $path(test1) } -body { set f1 [open $path(test1) w] | | | | 2519 2520 2521 2522 2523 2524 2525 2526 2527 2528 2529 2530 2531 2532 2533 2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544 2545 2546 2547 2548 2549 2550 2551 | } -cleanup { chan close $f1 } -result {18 24 30} test chan-io-29.19 {Explicit and implicit flushes} -setup { file delete $path(test1) } -body { set f1 [open $path(test1) w] chan configure $f1 -translation lf set x "" chan puts $f1 hello chan puts $f1 hello chan puts $f1 hello chan flush $f1 lappend x [file size $path(test1)] chan puts $f1 hello chan flush $f1 lappend x [file size $path(test1)] chan puts $f1 hello chan close $f1 lappend x [file size $path(test1)] } -result {18 24 30} test chan-io-29.20 {Implicit flush when buffer is full} -setup { file delete $path(test1) } -body { set f1 [open $path(test1) w] chan configure $f1 -translation lf set line "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789" for {set x 0} {$x < 100} {incr x} { chan puts $f1 $line } set z "" lappend z [file size $path(test1)] for {set x 0} {$x < 100} {incr x} { |
︙ | ︙ | |||
2678 2679 2680 2681 2682 2683 2684 | } string tolower $x } -match glob -result {1 {error flushing "*": broken pipe} {posix epipe {broken pipe}}} test chan-io-29.28 {Tcl_WriteChars, lf mode} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] | | | | | 2678 2679 2680 2681 2682 2683 2684 2685 2686 2687 2688 2689 2690 2691 2692 2693 2694 2695 2696 2697 2698 2699 2700 2701 2702 2703 2704 2705 2706 2707 2708 2709 2710 2711 2712 | } string tolower $x } -match glob -result {1 {error flushing "*": broken pipe} {posix epipe {broken pipe}}} test chan-io-29.28 {Tcl_WriteChars, lf mode} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts $f hello\nthere\nand\nhere chan flush $f file size $path(test1) } -cleanup { chan close $f } -result 21 test chan-io-29.29 {Tcl_WriteChars, cr mode} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f -translation cr chan puts $f hello\nthere\nand\nhere chan close $f file size $path(test1) } -result 21 test chan-io-29.30 {Tcl_WriteChars, crlf mode} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f -translation crlf chan puts $f hello\nthere\nand\nhere chan close $f file size $path(test1) } -result 25 test chan-io-29.31 {Tcl_WriteChars, background flush} -setup { file delete $path(pipe) file delete $path(output) |
︙ | ︙ | |||
3176 3177 3178 3179 3180 3181 3182 | chan close $f } -result {abc def 0 {} 1 {} 1} test chan-io-30.20 {Tcl_Write, ^Z in middle ignored, Tcl_Read lf} -setup { file delete $path(test1) set l "" } -body { set f [open $path(test1) w] | | | | | | | | 3176 3177 3178 3179 3180 3181 3182 3183 3184 3185 3186 3187 3188 3189 3190 3191 3192 3193 3194 3195 3196 3197 3198 3199 3200 3201 3202 3203 3204 3205 3206 3207 3208 3209 3210 3211 3212 3213 3214 3215 3216 3217 3218 3219 3220 3221 3222 3223 3224 3225 3226 3227 3228 3229 3230 3231 3232 3233 3234 | chan close $f } -result {abc def 0 {} 1 {} 1} test chan-io-30.20 {Tcl_Write, ^Z in middle ignored, Tcl_Read lf} -setup { file delete $path(test1) set l "" } -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts $f [format "abc\ndef\n%cghi\nqrs" 26] chan close $f set f [open $path(test1) r] chan configure $f -translation lf lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan eof $f] lappend l [chan gets $f] lappend l [chan eof $f] lappend l [chan gets $f] lappend l [chan eof $f] lappend l [chan gets $f] lappend l [chan eof $f] } -cleanup { chan close $f } -result "abc def 0 \x1Aghi 0 qrs 0 {} 1" test chan-io-30.21 {Tcl_Write, ^Z in middle ignored, Tcl_Read cr} -setup { file delete $path(test1) set l "" } -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts $f [format "abc\ndef\n%cghi\nqrs" 26] chan close $f set f [open $path(test1) r] chan configure $f -translation cr set x [chan gets $f] lappend l [string equal $x "abc\ndef\n\x1Aghi\nqrs\n"] lappend l [chan eof $f] lappend l [chan gets $f] lappend l [chan eof $f] } -cleanup { chan close $f } -result {1 1 {} 1} test chan-io-30.22 {Tcl_Write, ^Z in middle ignored, Tcl_Read crlf} -setup { file delete $path(test1) set l "" } -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts $f [format "abc\ndef\n%cghi\nqrs" 26] chan close $f set f [open $path(test1) r] chan configure $f -translation crlf set x [chan gets $f] lappend l [string equal $x "abc\ndef\n\x1Aghi\nqrs\n"] lappend l [chan eof $f] lappend l [chan gets $f] lappend l [chan eof $f] } -cleanup { chan close $f |
︙ | ︙ | |||
3730 3731 3732 3733 3734 3735 3736 | chan close $f } -result {abc def 0 {} 1} test chan-io-31.22 {Tcl_Write, ^Z in middle ignored, Tcl_Gets lf} -setup { file delete $path(test1) set l "" } -body { set f [open $path(test1) w] | | | | | | | | 3730 3731 3732 3733 3734 3735 3736 3737 3738 3739 3740 3741 3742 3743 3744 3745 3746 3747 3748 3749 3750 3751 3752 3753 3754 3755 3756 3757 3758 3759 3760 3761 3762 3763 3764 3765 3766 3767 3768 3769 3770 3771 3772 3773 3774 3775 3776 3777 3778 3779 3780 3781 3782 3783 3784 3785 3786 3787 3788 3789 3790 3791 3792 | chan close $f } -result {abc def 0 {} 1} test chan-io-31.22 {Tcl_Write, ^Z in middle ignored, Tcl_Gets lf} -setup { file delete $path(test1) set l "" } -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26] chan close $f set f [open $path(test1) r] chan configure $f -translation lf lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan eof $f] lappend l [chan gets $f] lappend l [chan eof $f] lappend l [chan gets $f] lappend l [chan eof $f] lappend l [chan gets $f] lappend l [chan eof $f] } -cleanup { chan close $f } -result "abc def 0 \x1Aqrs 0 tuv 0 {} 1" test chan-io-31.23 {Tcl_Write, ^Z in middle ignored, Tcl_Gets cr} -setup { file delete $path(test1) set l "" } -body { set f [open $path(test1) w] chan configure $f -translation cr chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26] chan close $f set f [open $path(test1) r] chan configure $f -translation cr lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan eof $f] lappend l [chan gets $f] lappend l [chan eof $f] lappend l [chan gets $f] lappend l [chan eof $f] lappend l [chan gets $f] lappend l [chan eof $f] } -cleanup { chan close $f } -result "abc def 0 \x1Aqrs 0 tuv 0 {} 1" test chan-io-31.24 {Tcl_Write, ^Z in middle ignored, Tcl_Gets crlf} -setup { file delete $path(test1) set l "" } -body { set f [open $path(test1) w] chan configure $f -translation crlf chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26] chan close $f set f [open $path(test1) r] chan configure $f -translation crlf lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan eof $f] lappend l [chan gets $f] lappend l [chan eof $f] lappend l [chan gets $f] lappend l [chan eof $f] |
︙ | ︙ | |||
3832 3833 3834 3835 3836 3837 3838 | chan close $f } -result {abc def 0 {} 1} test chan-io-31.27 {Tcl_Write cr, ^Z in middle, Tcl_Gets auto} -setup { file delete $path(test1) set l "" } -body { set f [open $path(test1) w] | | | | | | 3832 3833 3834 3835 3836 3837 3838 3839 3840 3841 3842 3843 3844 3845 3846 3847 3848 3849 3850 3851 3852 3853 3854 3855 3856 3857 3858 3859 3860 3861 3862 3863 3864 3865 3866 3867 3868 3869 3870 3871 3872 3873 3874 3875 3876 3877 3878 3879 3880 3881 3882 3883 3884 3885 3886 3887 3888 3889 3890 3891 3892 3893 3894 3895 3896 3897 3898 3899 3900 | chan close $f } -result {abc def 0 {} 1} test chan-io-31.27 {Tcl_Write cr, ^Z in middle, Tcl_Gets auto} -setup { file delete $path(test1) set l "" } -body { set f [open $path(test1) w] chan configure $f -translation cr chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26] chan close $f set f [open $path(test1) r] chan configure $f -translation auto -eofchar \x1A lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan eof $f] lappend l [chan gets $f] lappend l [chan eof $f] } -cleanup { chan close $f } -result {abc def 0 {} 1} test chan-io-31.28 {Tcl_Write cr, ^Z in middle, Tcl_Gets cr} -setup { file delete $path(test1) set l "" } -body { set f [open $path(test1) w] chan configure $f -translation cr chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26] chan close $f set f [open $path(test1) r] chan configure $f -translation cr -eofchar \x1A lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan eof $f] lappend l [chan gets $f] lappend l [chan eof $f] } -cleanup { chan close $f } -result {abc def 0 {} 1} test chan-io-31.29 {Tcl_Write crlf, ^Z in middle, Tcl_Gets auto} -setup { file delete $path(test1) set l "" } -body { set f [open $path(test1) w] chan configure $f -translation crlf chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26] chan close $f set f [open $path(test1) r] chan configure $f -translation auto -eofchar \x1A lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan eof $f] lappend l [chan gets $f] lappend l [chan eof $f] } -cleanup { chan close $f } -result {abc def 0 {} 1} test chan-io-31.30 {Tcl_Write crlf, ^Z in middle, Tcl_Gets crlf} -setup { file delete $path(test1) set l "" } -body { set f [open $path(test1) w] chan configure $f -translation crlf chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26] chan close $f set f [open $path(test1) r] chan configure $f -translation crlf -eofchar \x1A lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan eof $f] |
︙ | ︙ | |||
4217 4218 4219 4220 4221 4222 4223 | set x 24 chan gets $f x(0) } -returnCodes error -cleanup { chan close $f } -result {can't set "x(0)": variable isn't array} test chan-io-33.8 {Tcl_Gets, exercising double buffering} { set f [open $path(test3) w] | | | | | 4217 4218 4219 4220 4221 4222 4223 4224 4225 4226 4227 4228 4229 4230 4231 4232 4233 4234 4235 4236 4237 4238 4239 4240 4241 4242 4243 4244 4245 4246 4247 4248 4249 4250 4251 4252 4253 4254 4255 4256 4257 | set x 24 chan gets $f x(0) } -returnCodes error -cleanup { chan close $f } -result {can't set "x(0)": variable isn't array} test chan-io-33.8 {Tcl_Gets, exercising double buffering} { set f [open $path(test3) w] chan configure $f -translation lf set x "" for {set y 0} {$y < 99} {incr y} {set x "a$x"} for {set y 0} {$y < 100} {incr y} {chan puts $f $x} chan close $f set f [open $path(test3) r] chan configure $f -translation lf for {set y 0} {$y < 100} {incr y} {chan gets $f} chan close $f set y } 100 test chan-io-33.9 {Tcl_Gets, exercising double buffering} { set f [open $path(test3) w] chan configure $f -translation lf set x "" for {set y 0} {$y < 99} {incr y} {set x "a$x"} for {set y 0} {$y < 200} {incr y} {chan puts $f $x} chan close $f set f [open $path(test3) r] chan configure $f -translation lf for {set y 0} {$y < 200} {incr y} {chan gets $f} chan close $f set y } 200 test chan-io-33.10 {Tcl_Gets, exercising double buffering} { set f [open $path(test3) w] chan configure $f -translation lf set x "" for {set y 0} {$y < 99} {incr y} {set x "a$x"} for {set y 0} {$y < 300} {incr y} {chan puts $f $x} chan close $f set f [open $path(test3) r] chan configure $f -translation lf for {set y 0} {$y < 300} {incr y} {chan gets $f} |
︙ | ︙ | |||
4268 4269 4270 4271 4272 4273 4274 | } -cleanup { chan close $f1 } -result 0 test chan-io-34.2 {Tcl_Seek to offset from start} -setup { file delete $path(test1) } -body { set f1 [open $path(test1) w] | | | | | | | | 4268 4269 4270 4271 4272 4273 4274 4275 4276 4277 4278 4279 4280 4281 4282 4283 4284 4285 4286 4287 4288 4289 4290 4291 4292 4293 4294 4295 4296 4297 4298 4299 4300 4301 4302 4303 4304 4305 4306 4307 4308 4309 4310 4311 4312 4313 4314 4315 4316 4317 4318 4319 4320 4321 4322 4323 4324 4325 4326 4327 4328 4329 4330 4331 4332 4333 4334 4335 4336 4337 4338 4339 4340 4341 4342 4343 4344 4345 4346 4347 4348 4349 4350 4351 4352 4353 4354 | } -cleanup { chan close $f1 } -result 0 test chan-io-34.2 {Tcl_Seek to offset from start} -setup { file delete $path(test1) } -body { set f1 [open $path(test1) w] chan configure $f1 -translation lf chan puts $f1 "abcdefghijklmnopqrstuvwxyz" chan puts $f1 "abcdefghijklmnopqrstuvwxyz" chan close $f1 set f1 [open $path(test1) r] chan seek $f1 10 start chan tell $f1 } -cleanup { chan close $f1 } -result 10 test chan-io-34.3 {Tcl_Seek to end of file} -setup { file delete $path(test1) } -body { set f1 [open $path(test1) w] chan configure $f1 -translation lf chan puts $f1 "abcdefghijklmnopqrstuvwxyz" chan puts $f1 "abcdefghijklmnopqrstuvwxyz" chan close $f1 set f1 [open $path(test1) r] chan seek $f1 0 end chan tell $f1 } -cleanup { chan close $f1 } -result 54 test chan-io-34.4 {Tcl_Seek to offset from end of file} -setup { file delete $path(test1) } -body { set f1 [open $path(test1) w] chan configure $f1 -translation lf chan puts $f1 "abcdefghijklmnopqrstuvwxyz" chan puts $f1 "abcdefghijklmnopqrstuvwxyz" chan close $f1 set f1 [open $path(test1) r] chan seek $f1 -10 end chan tell $f1 } -cleanup { chan close $f1 } -result 44 test chan-io-34.5 {Tcl_Seek to offset from current position} -setup { file delete $path(test1) } -body { set f1 [open $path(test1) w] chan configure $f1 -translation lf chan puts $f1 "abcdefghijklmnopqrstuvwxyz" chan puts $f1 "abcdefghijklmnopqrstuvwxyz" chan close $f1 set f1 [open $path(test1) r] chan seek $f1 10 current chan seek $f1 10 current chan tell $f1 } -cleanup { chan close $f1 } -result 20 test chan-io-34.6 {Tcl_Seek to offset from end of file} -setup { file delete $path(test1) } -body { set f1 [open $path(test1) w] chan configure $f1 -translation lf chan puts $f1 "abcdefghijklmnopqrstuvwxyz" chan puts $f1 "abcdefghijklmnopqrstuvwxyz" chan close $f1 set f1 [open $path(test1) r] chan seek $f1 -10 end list [chan tell $f1] [chan read $f1] } -cleanup { chan close $f1 } -result {44 {rstuvwxyz }} test chan-io-34.7 {Tcl_Seek to offset from end of file, then to current position} -setup { file delete $path(test1) } -body { set f1 [open $path(test1) w] chan configure $f1 -translation lf chan puts $f1 "abcdefghijklmnopqrstuvwxyz" chan puts $f1 "abcdefghijklmnopqrstuvwxyz" chan close $f1 set f1 [open $path(test1) r] chan seek $f1 -10 end set c1 [chan tell $f1] set r1 [chan read $f1 5] |
︙ | ︙ | |||
4364 4365 4366 4367 4368 4369 4370 | } -returnCodes error -cleanup { chan close $pipe } -match glob -result {error during seek on "*": invalid argument} test chan-io-34.9 {Tcl_Seek, testing buffered input flushing} -setup { file delete $path(test3) } -body { set f [open $path(test3) w] | | | 4364 4365 4366 4367 4368 4369 4370 4371 4372 4373 4374 4375 4376 4377 4378 | } -returnCodes error -cleanup { chan close $pipe } -match glob -result {error during seek on "*": invalid argument} test chan-io-34.9 {Tcl_Seek, testing buffered input flushing} -setup { file delete $path(test3) } -body { set f [open $path(test3) w] chan configure $f chan puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" chan close $f set f [open $path(test3) RDWR] set x [chan read $f 1] chan seek $f 3 lappend x [chan read $f 1] chan seek $f 0 start |
︙ | ︙ | |||
4412 4413 4414 4415 4416 4417 4418 | chan seek $f 2 set x [chan gets $f] chan close $f list $x [viewFile test3] } "zzy xyzzy" test chan-io-34.12 {Tcl_Seek testing combination of write, seek back and read} { set f [open $path(test3) w] | | | | 4412 4413 4414 4415 4416 4417 4418 4419 4420 4421 4422 4423 4424 4425 4426 4427 4428 4429 4430 | chan seek $f 2 set x [chan gets $f] chan close $f list $x [viewFile test3] } "zzy xyzzy" test chan-io-34.12 {Tcl_Seek testing combination of write, seek back and read} { set f [open $path(test3) w] chan configure $f -translation lf chan puts $f xyz\n123 chan close $f set f [open $path(test3) a+] chan configure $f -translation lf chan puts $f xyzzy chan flush $f set x [chan tell $f] chan seek $f -4 cur set y [chan gets $f] chan close $f list $x [viewFile test3] $y |
︙ | ︙ | |||
4439 4440 4441 4442 4443 4444 4445 | } -cleanup { chan close $f1 } -result 0 test chan-io-34.14 {Tcl_Tell after seek to end of file} -setup { file delete $path(test1) } -body { set f1 [open $path(test1) w] | | | | 4439 4440 4441 4442 4443 4444 4445 4446 4447 4448 4449 4450 4451 4452 4453 4454 4455 4456 4457 4458 4459 4460 4461 4462 4463 4464 4465 4466 4467 | } -cleanup { chan close $f1 } -result 0 test chan-io-34.14 {Tcl_Tell after seek to end of file} -setup { file delete $path(test1) } -body { set f1 [open $path(test1) w] chan configure $f1 -translation lf chan puts $f1 "abcdefghijklmnopqrstuvwxyz" chan puts $f1 "abcdefghijklmnopqrstuvwxyz" chan close $f1 set f1 [open $path(test1) r] chan seek $f1 0 end chan tell $f1 } -cleanup { chan close $f1 } -result 54 test chan-io-34.15 {Tcl_Tell combined with seeking} -setup { file delete $path(test1) } -body { set f1 [open $path(test1) w] chan configure $f1 -translation lf chan puts $f1 "abcdefghijklmnopqrstuvwxyz" chan puts $f1 "abcdefghijklmnopqrstuvwxyz" chan close $f1 set f1 [open $path(test1) r] chan seek $f1 10 start set c1 [chan tell $f1] chan seek $f1 10 current |
︙ | ︙ | |||
4484 4485 4486 4487 4488 4489 4490 | chan close $f1 set c } -1 test chan-io-34.18 {Tcl_Tell combined with seeking and reading} -setup { file delete $path(test2) } -body { set f [open $path(test2) w] | | | | 4484 4485 4486 4487 4488 4489 4490 4491 4492 4493 4494 4495 4496 4497 4498 4499 4500 4501 4502 4503 4504 4505 4506 4507 4508 4509 4510 4511 4512 4513 4514 4515 4516 4517 | chan close $f1 set c } -1 test chan-io-34.18 {Tcl_Tell combined with seeking and reading} -setup { file delete $path(test2) } -body { set f [open $path(test2) w] chan configure $f -translation lf chan puts -nonewline $f "line1\nline2\nline3\nline4\nline5\n" chan close $f set f [open $path(test2)] chan configure $f -translation lf set x [chan tell $f] chan read $f 3 lappend x [chan tell $f] chan seek $f 2 lappend x [chan tell $f] chan seek $f 10 current lappend x [chan tell $f] chan seek $f 0 end lappend x [chan tell $f] } -cleanup { chan close $f } -result {0 3 2 12 30} test chan-io-34.19 {Tcl_Tell combined with opening in append mode} -body { set f [open $path(test3) w] chan configure $f -translation lf chan puts $f "abcdefghijklmnopqrstuvwxyz" chan puts $f "abcdefghijklmnopqrstuvwxyz" chan close $f set f [open $path(test3) a] chan tell $f } -cleanup { chan close $f |
︙ | ︙ | |||
4730 4731 4732 4733 4734 4735 4736 | } -cleanup { chan close $f } -result {10 8 1} test chan-io-35.12 {Tcl_Eof, eof char in middle, lf write, auto read} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] | | | | | | | | 4730 4731 4732 4733 4734 4735 4736 4737 4738 4739 4740 4741 4742 4743 4744 4745 4746 4747 4748 4749 4750 4751 4752 4753 4754 4755 4756 4757 4758 4759 4760 4761 4762 4763 4764 4765 4766 4767 4768 4769 4770 4771 4772 4773 4774 4775 4776 4777 4778 4779 4780 4781 4782 4783 4784 4785 4786 4787 4788 4789 4790 4791 4792 4793 4794 4795 4796 4797 4798 4799 4800 4801 4802 4803 4804 4805 4806 4807 4808 4809 4810 4811 4812 4813 4814 | } -cleanup { chan close $f } -result {10 8 1} test chan-io-35.12 {Tcl_Eof, eof char in middle, lf write, auto read} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts $f [format abc\ndef\n%cqrs\nuvw 26] chan close $f set c [file size $path(test1)] set f [open $path(test1) r] chan configure $f -translation auto -eofchar \x1A list $c [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f } -result {17 8 1} test chan-io-35.13 {Tcl_Eof, eof char in middle, lf write, lf read} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f -translation lf chan puts $f [format abc\ndef\n%cqrs\nuvw 26] chan close $f set c [file size $path(test1)] set f [open $path(test1) r] chan configure $f -translation lf -eofchar \x1A list $c [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f } -result {17 8 1} test chan-io-35.14 {Tcl_Eof, eof char in middle, cr write, auto read} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f -translation cr chan puts $f [format abc\ndef\n%cqrs\nuvw 26] chan close $f set c [file size $path(test1)] set f [open $path(test1) r] chan configure $f -translation auto -eofchar \x1A list $c [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f } -result {17 8 1} test chan-io-35.15 {Tcl_Eof, eof char in middle, cr write, cr read} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f -translation cr chan puts $f [format abc\ndef\n%cqrs\nuvw 26] chan close $f set c [file size $path(test1)] set f [open $path(test1) r] chan configure $f -translation cr -eofchar \x1A list $c [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f } -result {17 8 1} test chan-io-35.16 {Tcl_Eof, eof char in middle, crlf write, auto read} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f -translation crlf chan puts $f [format abc\ndef\n%cqrs\nuvw 26] chan close $f set c [file size $path(test1)] set f [open $path(test1) r] chan configure $f -translation auto -eofchar \x1A list $c [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f } -result {21 8 1} test chan-io-35.17 {Tcl_Eof, eof char in middle, crlf write, crlf read} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] chan configure $f -translation crlf chan puts $f [format abc\ndef\n%cqrs\nuvw 26] chan close $f set c [file size $path(test1)] set f [open $path(test1) r] chan configure $f -translation crlf -eofchar \x1A list $c [string length [chan read $f]] [chan eof $f] } -cleanup { |
︙ | ︙ | |||
5074 5075 5076 5077 5078 5079 5080 | chan close $f1 } -result {0 21} test chan-io-39.8 {Tcl_SetChannelOption, different buffering options} -setup { file delete $path(test1) set l "" } -body { set f1 [open $path(test1) w] | | | 5074 5075 5076 5077 5078 5079 5080 5081 5082 5083 5084 5085 5086 5087 5088 | chan close $f1 } -result {0 21} test chan-io-39.8 {Tcl_SetChannelOption, different buffering options} -setup { file delete $path(test1) set l "" } -body { set f1 [open $path(test1) w] chan configure $f1 -translation lf -buffering none chan puts -nonewline $f1 hello lappend l [file size $path(test1)] chan puts -nonewline $f1 hello lappend l [file size $path(test1)] chan configure $f1 -buffering full chan puts -nonewline $f1 hello lappend l [file size $path(test1)] |
︙ | ︙ | |||
5371 5372 5373 5374 5375 5376 5377 | file stat $path(test3) stats format 0o%03o [expr {$stats(mode) & 0o777}] } -result [format 0o%03o [expr {0o666 & ~ $umaskValue}]] test chan-io-40.4 {POSIX open access modes: CREAT} -setup { file delete $path(test3) } -body { set f [open $path(test3) w] | | | | | 5371 5372 5373 5374 5375 5376 5377 5378 5379 5380 5381 5382 5383 5384 5385 5386 5387 5388 5389 5390 5391 5392 5393 5394 5395 5396 5397 5398 5399 5400 5401 5402 | file stat $path(test3) stats format 0o%03o [expr {$stats(mode) & 0o777}] } -result [format 0o%03o [expr {0o666 & ~ $umaskValue}]] test chan-io-40.4 {POSIX open access modes: CREAT} -setup { file delete $path(test3) } -body { set f [open $path(test3) w] chan configure $f chan puts $f xyzzy chan close $f set f [open $path(test3) {WRONLY CREAT}] chan configure $f chan puts -nonewline $f "ab" chan close $f set f [open $path(test3) r] chan gets $f } -cleanup { chan close $f } -result abzzy test chan-io-40.5 {POSIX open access modes: APPEND} -setup { file delete $path(test3) set x "" } -body { set f [open $path(test3) w] chan configure $f -translation lf chan puts $f xyzzy chan close $f set f [open $path(test3) {WRONLY APPEND}] chan configure $f -translation lf chan puts $f "new line" chan seek $f 0 chan puts $f "abc" |
︙ | ︙ | |||
5417 5418 5419 5420 5421 5422 5423 | chan close $f open $path(test3) {WRONLY CREAT EXCL} } -returnCodes error -result {(?i)couldn't open ".*test3": file (already )?exists} test chan-io-40.7 {POSIX open access modes: EXCL} -setup { file delete $path(test3) } -body { set f [open $path(test3) {WRONLY CREAT EXCL}] | | | 5417 5418 5419 5420 5421 5422 5423 5424 5425 5426 5427 5428 5429 5430 5431 | chan close $f open $path(test3) {WRONLY CREAT EXCL} } -returnCodes error -result {(?i)couldn't open ".*test3": file (already )?exists} test chan-io-40.7 {POSIX open access modes: EXCL} -setup { file delete $path(test3) } -body { set f [open $path(test3) {WRONLY CREAT EXCL}] chan configure $f chan puts $f "A test line" chan close $f viewFile test3 } -result {A test line} test chan-io-40.8 {POSIX open access modes: TRUNC} -setup { file delete $path(test3) } -body { |
︙ | ︙ | |||
5468 5469 5470 5471 5472 5473 5474 | test chan-io-40.12 {POSIX open access modes: WRONLY} -match regexp -body { file delete $path(test3) open $path(test3) WRONLY } -returnCodes error -result {(?i)couldn't open ".*test3": no such file or directory} test chan-io-40.13 {POSIX open access modes: WRONLY} -body { makeFile xyzzy test3 set f [open $path(test3) WRONLY] | | | 5468 5469 5470 5471 5472 5473 5474 5475 5476 5477 5478 5479 5480 5481 5482 | test chan-io-40.12 {POSIX open access modes: WRONLY} -match regexp -body { file delete $path(test3) open $path(test3) WRONLY } -returnCodes error -result {(?i)couldn't open ".*test3": no such file or directory} test chan-io-40.13 {POSIX open access modes: WRONLY} -body { makeFile xyzzy test3 set f [open $path(test3) WRONLY] chan configure $f chan puts -nonewline $f "ab" chan seek $f 0 current set x [list [catch {chan gets $f} msg] $msg] chan close $f lappend x [viewFile test3] } -match glob -result {1 {channel "*" wasn't opened for reading} abzzy} test chan-io-40.14 {POSIX open access modes: RDWR} -match regexp -body { |
︙ | ︙ |
Changes to tests/cmdAH.test.
︙ | ︙ | |||
1796 1797 1798 1799 1800 1801 1802 | # size test cmdAH-27.1 {Tcl_FileObjCmd: size} -returnCodes error -body { file size a b } -result {wrong # args: should be "file size name"} test cmdAH-27.2 {Tcl_FileObjCmd: size} { set oldsize [file size $gorpfile] set f [open $gorpfile a] | | | 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 | # size test cmdAH-27.1 {Tcl_FileObjCmd: size} -returnCodes error -body { file size a b } -result {wrong # args: should be "file size name"} test cmdAH-27.2 {Tcl_FileObjCmd: size} { set oldsize [file size $gorpfile] set f [open $gorpfile a] fconfigure $f -translation lf puts $f "More text" close $f expr {[file size $gorpfile] - $oldsize} } {10} test cmdAH-27.3 {Tcl_FileObjCmd: size} { list [catch {file size _bogus_} msg] [string tolower $msg] $errorCode } {1 {could not read "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}} |
︙ | ︙ |
Changes to tests/io.test.
︙ | ︙ | |||
63 64 65 66 67 68 69 | testConstraint makeFileInHome [expr {![file exists ~/_test_] && [file writable ~]}] # set up a long data file for some of the following tests set path(longfile) [makeFile {} longfile] set f [open $path(longfile) w] | | | 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 | testConstraint makeFileInHome [expr {![file exists ~/_test_] && [file writable ~]}] # set up a long data file for some of the following tests set path(longfile) [makeFile {} longfile] set f [open $path(longfile) w] fconfigure $f -translation lf for { set i 0 } { $i < 100 } { incr i} { puts $f "#123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef \#123456789abcdef01 \#" } close $f |
︙ | ︙ | |||
2225 2226 2227 2228 2229 2230 2231 | set t [testchannel type $f] close $f string compare $t file } 0 test io-25.1 {Tcl_GetChannelHandle, input} {testchannel} { set f [open $path(test1) w] | | | 2225 2226 2227 2228 2229 2230 2231 2232 2233 2234 2235 2236 2237 2238 2239 | set t [testchannel type $f] close $f string compare $t file } 0 test io-25.1 {Tcl_GetChannelHandle, input} {testchannel} { set f [open $path(test1) w] fconfigure $f -translation lf puts $f "1234567890\n098765432" close $f set f [open $path(test1) r] gets $f set l "" lappend l [testchannel inputbuffered $f] lappend l [tell $f] |
︙ | ︙ | |||
2274 2275 2276 2277 2278 2279 2280 | set s [file size $path(test1)] close $f set s } 0 test io-27.2 {FlushChannel, some output buffered} { file delete $path(test1) set f [open $path(test1) w] | | | | | | 2274 2275 2276 2277 2278 2279 2280 2281 2282 2283 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 | set s [file size $path(test1)] close $f set s } 0 test io-27.2 {FlushChannel, some output buffered} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf set l "" puts $f hello lappend l [file size $path(test1)] flush $f lappend l [file size $path(test1)] close $f lappend l [file size $path(test1)] set l } {0 6 6} test io-27.3 {FlushChannel, implicit flush on close} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf set l "" puts $f hello lappend l [file size $path(test1)] close $f lappend l [file size $path(test1)] set l } {0 6} test io-27.4 {FlushChannel, implicit flush when buffer fills} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf fconfigure $f -buffersize 60 set l "" lappend l [file size $path(test1)] for {set i 0} {$i < 12} {incr i} { puts $f hello } lappend l [file size $path(test1)] flush $f lappend l [file size $path(test1)] close $f set l } {0 60 72} test io-27.5 {FlushChannel, implicit flush when buffer fills and on close} \ {unixOrWin} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf -buffersize 60 set l "" lappend l [file size $path(test1)] for {set i 0} {$i < 12} {incr i} { puts $f hello } lappend l [file size $path(test1)] close $f |
︙ | ︙ | |||
2337 2338 2339 2340 2341 2342 2343 | # This test may fail on old Unix systems (seen on IRIX64 6.5) with # obsolete gettimeofday() calls. See Tcl Bugs 3530533, 1942197. file delete $path(pipe) file delete $path(output) set f [open $path(pipe) w] puts $f "set f \[[list open $path(output) w]]" puts $f { | | | 2337 2338 2339 2340 2341 2342 2343 2344 2345 2346 2347 2348 2349 2350 2351 | # This test may fail on old Unix systems (seen on IRIX64 6.5) with # obsolete gettimeofday() calls. See Tcl Bugs 3530533, 1942197. file delete $path(pipe) file delete $path(output) set f [open $path(pipe) w] puts $f "set f \[[list open $path(output) w]]" puts $f { fconfigure $f -translation lf -buffering none while {![eof stdin]} { after 20 puts -nonewline $f [read stdin 1024] } close $f } close $f |
︙ | ︙ | |||
2408 2409 2410 2411 2412 2413 2414 | set f [open $path(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". | | | | | 2408 2409 2410 2411 2412 2413 2414 2415 2416 2417 2418 2419 2420 2421 2422 2423 2424 2425 2426 2427 2428 2429 2430 2431 2432 2433 2434 2435 2436 2437 2438 2439 2440 2441 | set f [open $path(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 fconfigure stderr set f [open $path(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 $path(output) w] close $f set f [open "|[list [interpreter] pipe]" r+] fconfigure $f -blocking off puts -nonewline $f $x close $f set counter 0 while {([file size $path(output)] < 20480) && ($counter < 1000)} { after 20 [list incr [namespace which -variable counter]] vwait [namespace which -variable counter] |
︙ | ︙ | |||
2560 2561 2562 2563 2564 2565 2566 | test io-29.1 {Tcl_WriteChars, channel not writable} { list [catch {puts stdin hello} msg] $msg } {1 {channel "stdin" wasn't opened for writing}} test io-29.2 {Tcl_WriteChars, empty string} { file delete $path(test1) set f [open $path(test1) w] | | | | | | | | 2560 2561 2562 2563 2564 2565 2566 2567 2568 2569 2570 2571 2572 2573 2574 2575 2576 2577 2578 2579 2580 2581 2582 2583 2584 2585 2586 2587 2588 2589 2590 2591 2592 2593 2594 2595 2596 2597 2598 2599 2600 2601 2602 2603 2604 2605 2606 2607 2608 2609 2610 2611 2612 2613 2614 2615 2616 2617 2618 2619 2620 2621 2622 2623 2624 2625 2626 2627 2628 2629 2630 2631 2632 | test io-29.1 {Tcl_WriteChars, channel not writable} { list [catch {puts stdin hello} msg] $msg } {1 {channel "stdin" wasn't opened for writing}} test io-29.2 {Tcl_WriteChars, empty string} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f puts -nonewline $f "" close $f file size $path(test1) } 0 test io-29.3 {Tcl_WriteChars, nonempty string} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f puts -nonewline $f hello close $f file size $path(test1) } 5 test io-29.4 {Tcl_WriteChars, buffering in full buffering mode} {testchannel} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf -buffering full puts $f hello set l "" lappend l [testchannel outputbuffered $f] lappend l [file size $path(test1)] flush $f lappend l [testchannel outputbuffered $f] lappend l [file size $path(test1)] close $f set l } {6 0 0 6} test io-29.5 {Tcl_WriteChars, buffering in line buffering mode} {testchannel} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf -buffering line puts -nonewline $f hello set l "" lappend l [testchannel outputbuffered $f] lappend l [file size $path(test1)] puts $f hello lappend l [testchannel outputbuffered $f] lappend l [file size $path(test1)] close $f set l } {5 0 0 11} test io-29.6 {Tcl_WriteChars, buffering in no buffering mode} {testchannel} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf -buffering none puts -nonewline $f hello set l "" lappend l [testchannel outputbuffered $f] lappend l [file size $path(test1)] puts $f hello lappend l [testchannel outputbuffered $f] lappend l [file size $path(test1)] close $f set l } {0 5 0 11} test io-29.7 {Tcl_Flush, full buffering} {testchannel} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf -buffering full puts -nonewline $f hello set l "" lappend l [testchannel outputbuffered $f] lappend l [file size $path(test1)] puts $f hello lappend l [testchannel outputbuffered $f] lappend l [file size $path(test1)] |
︙ | ︙ | |||
2658 2659 2660 2661 2662 2663 2664 | } {5 0 0 5 0 11 0 11} test io-29.9 {Tcl_Flush, channel not writable} { list [catch {flush stdin} msg] $msg } {1 {channel "stdin" wasn't opened for writing}} test io-29.10 {Tcl_WriteChars, looping and buffering} { file delete $path(test1) set f1 [open $path(test1) w] | | | | 2658 2659 2660 2661 2662 2663 2664 2665 2666 2667 2668 2669 2670 2671 2672 2673 2674 2675 2676 2677 2678 2679 2680 2681 2682 2683 2684 | } {5 0 0 5 0 11 0 11} test io-29.9 {Tcl_Flush, channel not writable} { list [catch {flush stdin} msg] $msg } {1 {channel "stdin" wasn't opened for writing}} test io-29.10 {Tcl_WriteChars, looping and buffering} { file delete $path(test1) set f1 [open $path(test1) w] fconfigure $f1 -translation lf set f2 [open $path(longfile) r] for {set x 0} {$x < 10} {incr x} { puts $f1 [gets $f2] } close $f2 close $f1 file size $path(test1) } 387 test io-29.11 {Tcl_WriteChars, no newline, implicit flush} { file delete $path(test1) set f1 [open $path(test1) w] fconfigure $f1 set f2 [open $path(longfile) r] for {set x 0} {$x < 10} {incr x} { puts -nonewline $f1 [gets $f2] } close $f1 close $f2 file size $path(test1) |
︙ | ︙ | |||
2796 2797 2798 2799 2800 2801 2802 | lappend x [file size $path(test1)] close $f1 set x } {18 24 30} test io-29.19 {Explicit and implicit flushes} { file delete $path(test1) set f1 [open $path(test1) w] | | | | 2796 2797 2798 2799 2800 2801 2802 2803 2804 2805 2806 2807 2808 2809 2810 2811 2812 2813 2814 2815 2816 2817 2818 2819 2820 2821 2822 2823 2824 2825 2826 2827 2828 | lappend x [file size $path(test1)] close $f1 set x } {18 24 30} test io-29.19 {Explicit and implicit flushes} { file delete $path(test1) set f1 [open $path(test1) w] fconfigure $f1 -translation lf set x "" puts $f1 hello puts $f1 hello puts $f1 hello flush $f1 lappend x [file size $path(test1)] puts $f1 hello flush $f1 lappend x [file size $path(test1)] puts $f1 hello close $f1 lappend x [file size $path(test1)] set x } {18 24 30} test io-29.20 {Implicit flush when buffer is full} { file delete $path(test1) set f1 [open $path(test1) w] fconfigure $f1 -translation lf set line "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789" for {set x 0} {$x < 100} {incr x} { puts $f1 $line } set z "" lappend z [file size $path(test1)] for {set x 0} {$x < 100} {incr x} { |
︙ | ︙ | |||
2952 2953 2954 2955 2956 2957 2958 | } regsub {".*":} $x {"":} x string tolower $x } {1 {error flushing "": broken pipe} {posix epipe {broken pipe}}} test io-29.28 {Tcl_WriteChars, lf mode} { file delete $path(test1) set f [open $path(test1) w] | | | | | 2952 2953 2954 2955 2956 2957 2958 2959 2960 2961 2962 2963 2964 2965 2966 2967 2968 2969 2970 2971 2972 2973 2974 2975 2976 2977 2978 2979 2980 2981 2982 2983 2984 | } regsub {".*":} $x {"":} x string tolower $x } {1 {error flushing "": broken pipe} {posix epipe {broken pipe}}} test io-29.28 {Tcl_WriteChars, lf mode} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf puts $f hello\nthere\nand\nhere flush $f set s [file size $path(test1)] close $f set s } 21 test io-29.29 {Tcl_WriteChars, cr mode} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr puts $f hello\nthere\nand\nhere close $f file size $path(test1) } 21 test io-29.30 {Tcl_WriteChars, crlf mode} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf puts $f hello\nthere\nand\nhere close $f file size $path(test1) } 25 test io-29.31 {Tcl_WriteChars, background flush} stdio { # This test may fail on old Unix systems (seen on IRIX64 6.5) with # obsolete gettimeofday() calls. See Tcl Bugs 3530533, 1942197. |
︙ | ︙ | |||
3544 3545 3546 3547 3548 3549 3550 | lappend l [eof $f] close $f set l } {abc def 0 {} 1 {} 1} test io-30.20 {Tcl_Write, ^Z in middle ignored, Tcl_Read lf} { file delete $path(test1) set f [open $path(test1) w] | | | | | | | | 3544 3545 3546 3547 3548 3549 3550 3551 3552 3553 3554 3555 3556 3557 3558 3559 3560 3561 3562 3563 3564 3565 3566 3567 3568 3569 3570 3571 3572 3573 3574 3575 3576 3577 3578 3579 3580 3581 3582 3583 3584 3585 3586 3587 3588 3589 3590 3591 3592 3593 3594 3595 3596 3597 3598 3599 3600 3601 3602 3603 | lappend l [eof $f] close $f set l } {abc def 0 {} 1 {} 1} test io-30.20 {Tcl_Write, ^Z in middle ignored, Tcl_Read lf} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf set s [format "abc\ndef\n%cghi\nqrs" 26] puts $f $s close $f set f [open $path(test1) r] fconfigure $f -translation lf 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] lappend l [gets $f] lappend l [eof $f] close $f set l } "abc def 0 \x1Aghi 0 qrs 0 {} 1" test io-30.21 {Tcl_Write, ^Z in middle ignored, Tcl_Read cr} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf set s [format "abc\ndef\n%cghi\nqrs" 26] puts $f $s close $f set f [open $path(test1) r] fconfigure $f -translation cr set l "" set x [gets $f] lappend l [string compare $x "abc\ndef\n\x1Aghi\nqrs\n"] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] close $f set l } {0 1 {} 1} test io-30.22 {Tcl_Write, ^Z in middle ignored, Tcl_Read crlf} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf set s [format "abc\ndef\n%cghi\nqrs" 26] puts $f $s close $f set f [open $path(test1) r] fconfigure $f -translation crlf set l "" set x [gets $f] lappend l [string compare $x "abc\ndef\n\x1Aghi\nqrs\n"] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] close $f |
︙ | ︙ | |||
4080 4081 4082 4083 4084 4085 4086 | lappend l [eof $f] close $f set l } {abc def 0 {} 1} test io-31.22 {Tcl_Write, ^Z in middle ignored, Tcl_Gets lf} { file delete $path(test1) set f [open $path(test1) w] | | | | | | | | 4080 4081 4082 4083 4084 4085 4086 4087 4088 4089 4090 4091 4092 4093 4094 4095 4096 4097 4098 4099 4100 4101 4102 4103 4104 4105 4106 4107 4108 4109 4110 4111 4112 4113 4114 4115 4116 4117 4118 4119 4120 4121 4122 4123 4124 4125 4126 4127 4128 4129 4130 4131 4132 4133 4134 4135 4136 4137 4138 4139 4140 4141 4142 4143 | lappend l [eof $f] close $f set l } {abc def 0 {} 1} test io-31.22 {Tcl_Write, ^Z in middle ignored, Tcl_Gets lf} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf set s [format "abc\ndef\n%cqrs\ntuv" 26] puts $f $s close $f set f [open $path(test1) r] fconfigure $f -translation lf 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] lappend l [gets $f] lappend l [eof $f] close $f set l } "abc def 0 \x1Aqrs 0 tuv 0 {} 1" test io-31.23 {Tcl_Write, ^Z in middle ignored, Tcl_Gets cr} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr set s [format "abc\ndef\n%cqrs\ntuv" 26] puts $f $s close $f set f [open $path(test1) r] fconfigure $f -translation cr 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] lappend l [gets $f] lappend l [eof $f] close $f set l } "abc def 0 \x1Aqrs 0 tuv 0 {} 1" test io-31.24 {Tcl_Write, ^Z in middle ignored, Tcl_Gets crlf} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf set s [format "abc\ndef\n%cqrs\ntuv" 26] puts $f $s close $f set f [open $path(test1) r] fconfigure $f -translation crlf 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] |
︙ | ︙ | |||
4182 4183 4184 4185 4186 4187 4188 | lappend l [eof $f] close $f set l } {abc def 0 {} 1} test io-31.27 {Tcl_Write cr, ^Z in middle, Tcl_Gets auto} { file delete $path(test1) set f [open $path(test1) w] | | | | | | 4182 4183 4184 4185 4186 4187 4188 4189 4190 4191 4192 4193 4194 4195 4196 4197 4198 4199 4200 4201 4202 4203 4204 4205 4206 4207 4208 4209 4210 4211 4212 4213 4214 4215 4216 4217 4218 4219 4220 4221 4222 4223 4224 4225 4226 4227 4228 4229 4230 4231 4232 4233 4234 4235 4236 4237 4238 4239 4240 4241 4242 4243 4244 4245 4246 4247 4248 4249 4250 | lappend l [eof $f] close $f set l } {abc def 0 {} 1} test io-31.27 {Tcl_Write cr, ^Z in middle, Tcl_Gets auto} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr set s [format "abc\ndef\n%cqrs\ntuv" 26] puts $f $s close $f set f [open $path(test1) r] fconfigure $f -translation auto -eofchar \x1A set l "" lappend l [gets $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} test io-31.28 {Tcl_Write cr, ^Z in middle, Tcl_Gets cr} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr set s [format "abc\ndef\n%cqrs\ntuv" 26] puts $f $s close $f set f [open $path(test1) r] fconfigure $f -translation cr -eofchar \x1A set l "" lappend l [gets $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} test io-31.29 {Tcl_Write crlf, ^Z in middle, Tcl_Gets auto} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf set s [format "abc\ndef\n%cqrs\ntuv" 26] puts $f $s close $f set f [open $path(test1) r] fconfigure $f -translation auto -eofchar \x1A set l "" lappend l [gets $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} test io-31.30 {Tcl_Write crlf, ^Z in middle, Tcl_Gets crlf} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf set s [format "abc\ndef\n%cqrs\ntuv" 26] puts $f $s close $f set f [open $path(test1) r] fconfigure $f -translation crlf -eofchar \x1A set l "" lappend l [gets $f] |
︙ | ︙ | |||
4605 4606 4607 4608 4609 4610 4611 | set f [open $path(test3) r] set result [list [catch {gets $f x(0)} msg] $msg] close $f set result } {1 {can't set "x(0)": variable isn't array}} test io-33.8 {Tcl_Gets, exercising double buffering} { set f [open $path(test3) w] | | | | | 4605 4606 4607 4608 4609 4610 4611 4612 4613 4614 4615 4616 4617 4618 4619 4620 4621 4622 4623 4624 4625 4626 4627 4628 4629 4630 4631 4632 4633 4634 4635 4636 4637 4638 4639 4640 4641 4642 4643 4644 4645 | set f [open $path(test3) r] set result [list [catch {gets $f x(0)} msg] $msg] close $f set result } {1 {can't set "x(0)": variable isn't array}} test io-33.8 {Tcl_Gets, exercising double buffering} { set f [open $path(test3) w] fconfigure $f -translation lf set x "" for {set y 0} {$y < 99} {incr y} {set x "a$x"} for {set y 0} {$y < 100} {incr y} {puts $f $x} close $f set f [open $path(test3) r] fconfigure $f -translation lf for {set y 0} {$y < 100} {incr y} {gets $f} close $f set y } 100 test io-33.9 {Tcl_Gets, exercising double buffering} { set f [open $path(test3) w] fconfigure $f -translation lf set x "" for {set y 0} {$y < 99} {incr y} {set x "a$x"} for {set y 0} {$y < 200} {incr y} {puts $f $x} close $f set f [open $path(test3) r] fconfigure $f -translation lf for {set y 0} {$y < 200} {incr y} {gets $f} close $f set y } 200 test io-33.10 {Tcl_Gets, exercising double buffering} { set f [open $path(test3) w] fconfigure $f -translation lf set x "" for {set y 0} {$y < 99} {incr y} {set x "a$x"} for {set y 0} {$y < 300} {incr y} {puts $f $x} close $f set f [open $path(test3) r] fconfigure $f -translation lf for {set y 0} {$y < 300} {incr y} {gets $f} |
︙ | ︙ | |||
4759 4760 4761 4762 4763 4764 4765 | set c [tell $f1] close $f1 set c } 0 test io-34.2 {Tcl_Seek to offset from start} { file delete $path(test1) set f1 [open $path(test1) w] | | | | | | | | 4759 4760 4761 4762 4763 4764 4765 4766 4767 4768 4769 4770 4771 4772 4773 4774 4775 4776 4777 4778 4779 4780 4781 4782 4783 4784 4785 4786 4787 4788 4789 4790 4791 4792 4793 4794 4795 4796 4797 4798 4799 4800 4801 4802 4803 4804 4805 4806 4807 4808 4809 4810 4811 4812 4813 4814 4815 4816 4817 4818 4819 4820 4821 4822 4823 4824 4825 4826 4827 4828 4829 4830 4831 4832 4833 4834 4835 4836 4837 4838 4839 4840 4841 | set c [tell $f1] close $f1 set c } 0 test io-34.2 {Tcl_Seek to offset from start} { file delete $path(test1) set f1 [open $path(test1) w] fconfigure $f1 -translation lf puts $f1 "abcdefghijklmnopqrstuvwxyz" puts $f1 "abcdefghijklmnopqrstuvwxyz" close $f1 set f1 [open $path(test1) r] seek $f1 10 start set c [tell $f1] close $f1 set c } 10 test io-34.3 {Tcl_Seek to end of file} { file delete $path(test1) set f1 [open $path(test1) w] fconfigure $f1 -translation lf puts $f1 "abcdefghijklmnopqrstuvwxyz" puts $f1 "abcdefghijklmnopqrstuvwxyz" close $f1 set f1 [open $path(test1) r] seek $f1 0 end set c [tell $f1] close $f1 set c } 54 test io-34.4 {Tcl_Seek to offset from end of file} { file delete $path(test1) set f1 [open $path(test1) w] fconfigure $f1 -translation lf puts $f1 "abcdefghijklmnopqrstuvwxyz" puts $f1 "abcdefghijklmnopqrstuvwxyz" close $f1 set f1 [open $path(test1) r] seek $f1 -10 end set c [tell $f1] close $f1 set c } 44 test io-34.5 {Tcl_Seek to offset from current position} { file delete $path(test1) set f1 [open $path(test1) w] fconfigure $f1 -translation lf puts $f1 "abcdefghijklmnopqrstuvwxyz" puts $f1 "abcdefghijklmnopqrstuvwxyz" close $f1 set f1 [open $path(test1) r] seek $f1 10 current seek $f1 10 current set c [tell $f1] close $f1 set c } 20 test io-34.6 {Tcl_Seek to offset from end of file} { file delete $path(test1) set f1 [open $path(test1) w] fconfigure $f1 -translation lf puts $f1 "abcdefghijklmnopqrstuvwxyz" puts $f1 "abcdefghijklmnopqrstuvwxyz" close $f1 set f1 [open $path(test1) r] seek $f1 -10 end set c [tell $f1] set r [read $f1] close $f1 list $c $r } {44 {rstuvwxyz }} test io-34.7 {Tcl_Seek to offset from end of file, then to current position} { file delete $path(test1) set f1 [open $path(test1) w] fconfigure $f1 -translation lf puts $f1 "abcdefghijklmnopqrstuvwxyz" puts $f1 "abcdefghijklmnopqrstuvwxyz" close $f1 set f1 [open $path(test1) r] seek $f1 -10 end set c1 [tell $f1] set r1 [read $f1 5] |
︙ | ︙ | |||
4850 4851 4852 4853 4854 4855 4856 | close $f1 regsub {".*":} $x {"":} x string tolower $x } {1 {error during seek on "": invalid argument}} test io-34.9 {Tcl_Seek, testing buffered input flushing} { file delete $path(test3) set f [open $path(test3) w] | | | 4850 4851 4852 4853 4854 4855 4856 4857 4858 4859 4860 4861 4862 4863 4864 | close $f1 regsub {".*":} $x {"":} x string tolower $x } {1 {error during seek on "": invalid argument}} test io-34.9 {Tcl_Seek, testing buffered input flushing} { file delete $path(test3) set f [open $path(test3) w] fconfigure $f puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" close $f set f [open $path(test3) RDWR] set x [read $f 1] seek $f 3 lappend x [read $f 1] seek $f 0 start |
︙ | ︙ | |||
4898 4899 4900 4901 4902 4903 4904 | seek $f 2 set x [gets $f] close $f list $x [viewFile test3] } "zzy xyzzy" test io-34.12 {Tcl_Seek testing combination of write, seek back and read} { set f [open $path(test3) w] | | | | | | 4898 4899 4900 4901 4902 4903 4904 4905 4906 4907 4908 4909 4910 4911 4912 4913 4914 4915 4916 4917 4918 4919 4920 4921 4922 4923 4924 4925 4926 4927 4928 4929 4930 4931 4932 4933 4934 4935 4936 4937 4938 4939 4940 4941 4942 4943 4944 4945 4946 4947 4948 4949 4950 | seek $f 2 set x [gets $f] close $f list $x [viewFile test3] } "zzy xyzzy" test io-34.12 {Tcl_Seek testing combination of write, seek back and read} { set f [open $path(test3) w] fconfigure $f -translation lf puts $f xyz\n123 close $f set f [open $path(test3) a+] fconfigure $f -translation lf puts $f xyzzy flush $f set x [tell $f] seek $f -4 cur set y [gets $f] close $f list $x [viewFile test3] $y } {14 {xyz 123 xyzzy} zzy} test io-34.13 {Tcl_Tell at start of file} { file delete $path(test1) set f1 [open $path(test1) w] set p [tell $f1] close $f1 set p } 0 test io-34.14 {Tcl_Tell after seek to end of file} { file delete $path(test1) set f1 [open $path(test1) w] fconfigure $f1 -translation lf puts $f1 "abcdefghijklmnopqrstuvwxyz" puts $f1 "abcdefghijklmnopqrstuvwxyz" close $f1 set f1 [open $path(test1) r] seek $f1 0 end set c1 [tell $f1] close $f1 set c1 } 54 test io-34.15 {Tcl_Tell combined with seeking} { file delete $path(test1) set f1 [open $path(test1) w] fconfigure $f1 -translation lf puts $f1 "abcdefghijklmnopqrstuvwxyz" puts $f1 "abcdefghijklmnopqrstuvwxyz" close $f1 set f1 [open $path(test1) r] seek $f1 10 start set c1 [tell $f1] seek $f1 10 current |
︙ | ︙ | |||
4966 4967 4968 4969 4970 4971 4972 | gets $f1 close $f1 set c } -1 test io-34.18 {Tcl_Tell combined with seeking and reading} { file delete $path(test2) set f [open $path(test2) w] | | | | 4966 4967 4968 4969 4970 4971 4972 4973 4974 4975 4976 4977 4978 4979 4980 4981 4982 4983 4984 4985 4986 4987 4988 4989 4990 4991 4992 4993 4994 4995 4996 4997 4998 4999 | gets $f1 close $f1 set c } -1 test io-34.18 {Tcl_Tell combined with seeking and reading} { file delete $path(test2) set f [open $path(test2) w] fconfigure $f -translation lf puts -nonewline $f "line1\nline2\nline3\nline4\nline5\n" close $f set f [open $path(test2)] fconfigure $f -translation lf set x [tell $f] read $f 3 lappend x [tell $f] seek $f 2 lappend x [tell $f] seek $f 10 current lappend x [tell $f] seek $f 0 end lappend x [tell $f] close $f set x } {0 3 2 12 30} test io-34.19 {Tcl_Tell combined with opening in append mode} { set f [open $path(test3) w] fconfigure $f -translation lf puts $f "abcdefghijklmnopqrstuvwxyz" puts $f "abcdefghijklmnopqrstuvwxyz" close $f set f [open $path(test3) a] set c [tell $f] close $f set c |
︙ | ︙ | |||
5206 5207 5208 5209 5210 5211 5212 | set e [eof $f] close $f list $s $l $e } {10 8 1} test io-35.12 {Tcl_Eof, eof char in middle, lf write, auto read} { file delete $path(test1) set f [open $path(test1) w] | | | | | | | | 5206 5207 5208 5209 5210 5211 5212 5213 5214 5215 5216 5217 5218 5219 5220 5221 5222 5223 5224 5225 5226 5227 5228 5229 5230 5231 5232 5233 5234 5235 5236 5237 5238 5239 5240 5241 5242 5243 5244 5245 5246 5247 5248 5249 5250 5251 5252 5253 5254 5255 5256 5257 5258 5259 5260 5261 5262 5263 5264 5265 5266 5267 5268 5269 5270 5271 5272 5273 5274 5275 5276 5277 5278 5279 5280 5281 5282 5283 5284 5285 5286 5287 5288 5289 5290 5291 5292 5293 5294 5295 | set e [eof $f] close $f list $s $l $e } {10 8 1} test io-35.12 {Tcl_Eof, eof char in middle, lf write, auto read} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf set i [format abc\ndef\n%cqrs\nuvw 26] puts $f $i close $f set c [file size $path(test1)] set f [open $path(test1) r] fconfigure $f -translation auto -eofchar \x1A set l [string length [read $f]] set e [eof $f] close $f list $c $l $e } {17 8 1} test io-35.13 {Tcl_Eof, eof char in middle, lf write, lf read} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf set i [format abc\ndef\n%cqrs\nuvw 26] puts $f $i close $f set c [file size $path(test1)] set f [open $path(test1) r] fconfigure $f -translation lf -eofchar \x1A set l [string length [read $f]] set e [eof $f] close $f list $c $l $e } {17 8 1} test io-35.14 {Tcl_Eof, eof char in middle, cr write, auto read} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr set i [format abc\ndef\n%cqrs\nuvw 26] puts $f $i close $f set c [file size $path(test1)] set f [open $path(test1) r] fconfigure $f -translation auto -eofchar \x1A set l [string length [read $f]] set e [eof $f] close $f list $c $l $e } {17 8 1} test io-35.15 {Tcl_Eof, eof char in middle, cr write, cr read} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr set i [format abc\ndef\n%cqrs\nuvw 26] puts $f $i close $f set c [file size $path(test1)] set f [open $path(test1) r] fconfigure $f -translation cr -eofchar \x1A set l [string length [read $f]] set e [eof $f] close $f list $c $l $e } {17 8 1} test io-35.16 {Tcl_Eof, eof char in middle, crlf write, auto read} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf set i [format abc\ndef\n%cqrs\nuvw 26] puts $f $i close $f set c [file size $path(test1)] set f [open $path(test1) r] fconfigure $f -translation auto -eofchar \x1A set l [string length [read $f]] set e [eof $f] close $f list $c $l $e } {21 8 1} test io-35.17 {Tcl_Eof, eof char in middle, crlf write, crlf read} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation crlf set i [format abc\ndef\n%cqrs\nuvw 26] puts $f $i close $f set c [file size $path(test1)] set f [open $path(test1) r] fconfigure $f -translation crlf -eofchar \x1A set l [string length [read $f]] |
︙ | ︙ | |||
5352 5353 5354 5355 5356 5357 5358 | set e [eof $f] close $f list $s $l $e [scan [string index $in end] %c] } -result {1 1 1 13} test io-35.19 {Tcl_Eof, eof char in middle, cr write, crlf read} -body { file delete $path(test1) set f [open $path(test1) w] | | | | 5352 5353 5354 5355 5356 5357 5358 5359 5360 5361 5362 5363 5364 5365 5366 5367 5368 5369 5370 5371 5372 5373 5374 5375 5376 5377 5378 5379 5380 5381 | set e [eof $f] close $f list $s $l $e [scan [string index $in end] %c] } -result {1 1 1 13} test io-35.19 {Tcl_Eof, eof char in middle, cr write, crlf read} -body { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr set i [format abc\ndef\n%cqrs\nuvw 26] puts $f $i close $f set c [file size $path(test1)] set f [open $path(test1) r] fconfigure $f -translation crlf -eofchar \x1A set l [string length [set in [read $f]]] set e [eof $f] close $f list $c $l $e [scan [string index $in end] %c] } -result {17 8 1 13} test io-35.20 {Tcl_Eof, eof char in middle, cr write, crlf read} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation cr set i [format \n%cqrsuvw 26] puts $f $i close $f set c [file size $path(test1)] set f [open $path(test1) r] fconfigure $f -translation crlf -eofchar \x1A set l [string length [set in [read $f]]] |
︙ | ︙ | |||
5403 5404 5405 5406 5407 5408 5409 | lappend x [gets $f1] lappend x [fblocked $f1] close $f1 set x } {{} 1 hello 0 {} 1} test io-36.1.1 {Tcl_InputBlocked on nonblocking binary pipe} stdio { set f1 [open "|[list [interpreter]]" r+] | | | | 5403 5404 5405 5406 5407 5408 5409 5410 5411 5412 5413 5414 5415 5416 5417 5418 5419 | lappend x [gets $f1] lappend x [fblocked $f1] close $f1 set x } {{} 1 hello 0 {} 1} test io-36.1.1 {Tcl_InputBlocked on nonblocking binary pipe} stdio { set f1 [open "|[list [interpreter]]" r+] chan configure $f1 -encoding binary -translation lf puts $f1 { chan configure stdout -encoding binary -translation lf puts hello_from_pipe } flush $f1 gets $f1 fconfigure $f1 -blocking off -buffering full puts $f1 {puts hello} set x "" |
︙ | ︙ | |||
5653 5654 5655 5656 5657 5658 5659 | close $f1 set x } {0 21} test io-39.8 {Tcl_SetChannelOption, different buffering options} { file delete $path(test1) set f1 [open $path(test1) w] set l "" | | | 5653 5654 5655 5656 5657 5658 5659 5660 5661 5662 5663 5664 5665 5666 5667 | close $f1 set x } {0 21} test io-39.8 {Tcl_SetChannelOption, different buffering options} { file delete $path(test1) set f1 [open $path(test1) w] set l "" fconfigure $f1 -translation lf -buffering none puts -nonewline $f1 hello lappend l [file size $path(test1)] puts -nonewline $f1 hello lappend l [file size $path(test1)] fconfigure $f1 -buffering full puts -nonewline $f1 hello lappend l [file size $path(test1)] |
︙ | ︙ | |||
5937 5938 5939 5940 5941 5942 5943 | close $f file stat $path(test3) stats format 0o%03o [expr {$stats(mode)&0o777}] } [format 0o%03o [expr {0o666 & ~ $umaskValue}]] test io-40.4 {POSIX open access modes: CREAT} { file delete $path(test3) set f [open $path(test3) w] | | | | | 5937 5938 5939 5940 5941 5942 5943 5944 5945 5946 5947 5948 5949 5950 5951 5952 5953 5954 5955 5956 5957 5958 5959 5960 5961 5962 5963 5964 5965 5966 | close $f file stat $path(test3) stats format 0o%03o [expr {$stats(mode)&0o777}] } [format 0o%03o [expr {0o666 & ~ $umaskValue}]] test io-40.4 {POSIX open access modes: CREAT} { file delete $path(test3) set f [open $path(test3) w] fconfigure $f puts $f xyzzy close $f set f [open $path(test3) {WRONLY CREAT}] fconfigure $f puts -nonewline $f "ab" close $f set f [open $path(test3) r] set x [gets $f] close $f set x } abzzy test io-40.5 {POSIX open access modes: APPEND} { file delete $path(test3) set f [open $path(test3) w] fconfigure $f -translation lf puts $f xyzzy close $f set f [open $path(test3) {WRONLY APPEND}] fconfigure $f -translation lf puts $f "new line" seek $f 0 puts $f "abc" |
︙ | ︙ | |||
5980 5981 5982 5983 5984 5985 5986 | puts $f xyzzy close $f open $path(test3) {WRONLY CREAT EXCL} } -returnCodes error -result {(?i)couldn't open ".*test3": file (already )?exists} test io-40.7 {POSIX open access modes: EXCL} { file delete $path(test3) set f [open $path(test3) {WRONLY CREAT EXCL}] | | | 5980 5981 5982 5983 5984 5985 5986 5987 5988 5989 5990 5991 5992 5993 5994 | puts $f xyzzy close $f open $path(test3) {WRONLY CREAT EXCL} } -returnCodes error -result {(?i)couldn't open ".*test3": file (already )?exists} test io-40.7 {POSIX open access modes: EXCL} { file delete $path(test3) set f [open $path(test3) {WRONLY CREAT EXCL}] fconfigure $f puts $f "A test line" close $f viewFile test3 } {A test line} test io-40.8 {POSIX open access modes: TRUNC} { file delete $path(test3) set f [open $path(test3) w] |
︙ | ︙ | |||
6031 6032 6033 6034 6035 6036 6037 | test io-40.12 {POSIX open access modes: WRONLY} -match regexp -body { file delete $path(test3) open $path(test3) WRONLY } -returnCodes error -result {(?i)couldn't open ".*test3": no such file or directory} test io-40.13 {POSIX open access modes: WRONLY} { makeFile xyzzy test3 set f [open $path(test3) WRONLY] | | | 6031 6032 6033 6034 6035 6036 6037 6038 6039 6040 6041 6042 6043 6044 6045 | test io-40.12 {POSIX open access modes: WRONLY} -match regexp -body { file delete $path(test3) open $path(test3) WRONLY } -returnCodes error -result {(?i)couldn't open ".*test3": no such file or directory} test io-40.13 {POSIX open access modes: WRONLY} { makeFile xyzzy test3 set f [open $path(test3) WRONLY] fconfigure $f puts -nonewline $f "ab" seek $f 0 current set x [list [catch {gets $f} msg] $msg] close $f lappend x [viewFile test3] string compare [string tolower $x] \ [list 1 "channel \"$f\" wasn't opened for reading" abzzy] |
︙ | ︙ | |||
9422 9423 9424 9425 9426 9427 9428 | set fn [makeFile {} io-75.6] set f [open $fn w+] fconfigure $f -encoding binary # \x81 is an incomplete byte sequence in utf-8 puts -nonewline $f A\x81 flush $f seek $f 0 | | | | | 9422 9423 9424 9425 9426 9427 9428 9429 9430 9431 9432 9433 9434 9435 9436 9437 9438 9439 9440 9441 9442 9443 9444 9445 9446 9447 9448 9449 9450 9451 9452 9453 9454 9455 9456 9457 9458 9459 9460 9461 9462 9463 9464 9465 9466 9467 9468 9469 9470 9471 9472 | set fn [makeFile {} io-75.6] set f [open $fn w+] fconfigure $f -encoding binary # \x81 is an incomplete byte sequence in utf-8 puts -nonewline $f A\x81 flush $f seek $f 0 fconfigure $f -encoding utf-8 -buffering none \ -translation lf -profile strict } -body { gets $f } -cleanup { close $f removeFile io-75.6 } -match glob -returnCodes 1 -result {error reading "file*":\ invalid or incomplete multibyte or wide character} test io-75.6.1 {invalid utf-8 encoding, blocking gets is not ignored (-profile strict)} -setup { set fn [makeFile {} io-75.6.1] set f [open $fn w+] fconfigure $f -encoding binary # utf-8: \xC3 requires a 2nd byte > x80, but <x80 is delivered puts -nonewline $f A\xC3B flush $f seek $f 0 fconfigure $f -encoding utf-8 -buffering none \ -translation lf -profile strict } -body { gets $f } -cleanup { close $f removeFile io-75.6.1 } -match glob -returnCodes 1 -result {error reading "file*":\ invalid or incomplete multibyte or wide character} test io-75.6.2 {invalid utf-8 encoding, blocking gets is not ignored (-profile strict), recover functionality} -setup { set fn [makeFile {} io-75.6.2] set f [open $fn w+] fconfigure $f -encoding binary # utf-8: \xC3 requires a 2nd byte > x80, but <x80 is delivered puts -nonewline $f A\xC3B flush $f seek $f 0 fconfigure $f -encoding utf-8 -buffering none \ -translation lf -profile strict } -body { set l {} lappend l [catch {gets $f}] lappend l [tell $f] fconfigure $f -encoding binary lappend l [expr {[gets $f] eq "A\xC3B"}] |
︙ | ︙ | |||
9480 9481 9482 9483 9484 9485 9486 | set fn [makeFile {} io-75.6.3] set f [open $fn w+] fconfigure $f -encoding binary # utf-8: \xC3 requires a 2nd byte > x80, but <x80 is delivered puts -nonewline $f A\xC3B flush $f seek $f 0 | | | | 9480 9481 9482 9483 9484 9485 9486 9487 9488 9489 9490 9491 9492 9493 9494 9495 9496 9497 9498 9499 9500 9501 9502 9503 9504 9505 9506 9507 9508 9509 9510 9511 9512 | set fn [makeFile {} io-75.6.3] set f [open $fn w+] fconfigure $f -encoding binary # utf-8: \xC3 requires a 2nd byte > x80, but <x80 is delivered puts -nonewline $f A\xC3B flush $f seek $f 0 fconfigure $f -encoding utf-8 -buffering none \ -translation lf -profile strict -blocking 0 } -body { gets $f } -cleanup { close $f removeFile io-75.6.3 } -match glob -returnCodes 1 -result {error reading "file*":\ invalid or incomplete multibyte or wide character} test io-75.6.4 {incomplete utf-8 encoding, non blocking gets is not ignored (-profile strict)} -setup { set fn [makeFile {} io-75.6.4] set f [open $fn w+] fconfigure $f -encoding binary # \x81 is an incomplete byte sequence in utf-8 puts -nonewline $f A\x81 flush $f seek $f 0 fconfigure $f -encoding utf-8 -buffering none \ -translation lf -profile strict -blocking 0 } -body { gets $f # only the 2nd gets returns the error gets $f } -cleanup { close $f |
︙ | ︙ | |||
9520 9521 9522 9523 9524 9525 9526 | set fn [makeFile {} io-75.7] set f [open $fn w+] fconfigure $f -encoding binary # \x81 is invalid in utf-8 puts -nonewline $f A\x81 flush $f seek $f 0 | | | 9520 9521 9522 9523 9524 9525 9526 9527 9528 9529 9530 9531 9532 9533 9534 | set fn [makeFile {} io-75.7] set f [open $fn w+] fconfigure $f -encoding binary # \x81 is invalid in utf-8 puts -nonewline $f A\x81 flush $f seek $f 0 fconfigure $f -encoding utf-8 -buffering none -translation lf \ -profile strict } -body { list [catch {read $f} msg data] $msg [dict get $data -data] } -cleanup { close $f removeFile io-75.7 unset msg data f fn |
︙ | ︙ | |||
9656 9657 9658 9659 9660 9661 9662 | set f [open $fn w+] fconfigure $f -encoding binary # In shiftjis, \x81 starts a two-byte sequence. # But 2nd byte \xFF is not allowed puts -nonewline $f A\x81\xFFA flush $f seek $f 0 | | | 9656 9657 9658 9659 9660 9661 9662 9663 9664 9665 9666 9667 9668 9669 9670 | set f [open $fn w+] fconfigure $f -encoding binary # In shiftjis, \x81 starts a two-byte sequence. # But 2nd byte \xFF is not allowed puts -nonewline $f A\x81\xFFA flush $f seek $f 0 fconfigure $f -encoding shiftjis -blocking 0 -translation lf \ -profile strict } -body { set d [read $f] binary scan $d H* hd lappend hd [catch {set d [read $f]} msg data] $msg [dict exists $data -data] } -cleanup { close $f |
︙ | ︙ | |||
9680 9681 9682 9683 9684 9685 9686 | set res {} set fn [makeFile {} io-75.12] set f [open $fn w+] fconfigure $f -encoding binary puts -nonewline $f A\x81 flush $f seek $f 0 | | | 9680 9681 9682 9683 9684 9685 9686 9687 9688 9689 9690 9691 9692 9693 9694 | set res {} set fn [makeFile {} io-75.12] set f [open $fn w+] fconfigure $f -encoding binary puts -nonewline $f A\x81 flush $f seek $f 0 fconfigure $f -encoding utf-8 -buffering none -translation lf } -body { catch {read $f} errmsg lappend res $errmsg chan configure $f -profile tcl8 seek $f 0 set d [read $f] binary scan $d H* hd |
︙ | ︙ | |||
9708 9709 9710 9711 9712 9713 9714 | set fn [makeFile {} io-75.13] set f [open $fn w+] fconfigure $f -encoding binary # \x81 is invalid in utf-8 puts -nonewline $f A\x81 flush $f seek $f 0 | | | 9708 9709 9710 9711 9712 9713 9714 9715 9716 9717 9718 9719 9720 9721 9722 | set fn [makeFile {} io-75.13] set f [open $fn w+] fconfigure $f -encoding binary # \x81 is invalid in utf-8 puts -nonewline $f A\x81 flush $f seek $f 0 fconfigure $f -encoding utf-8 -blocking 0 -translation lf \ -profile strict } -body { set d [read $f] binary scan $d H* hd lappend hd [catch {read $f} msg data] $msg [dict exists $data -data] } -cleanup { close $f |
︙ | ︙ | |||
9732 9733 9734 9735 9736 9737 9738 | } -setup { set chan [file tempfile] fconfigure $chan -encoding binary # \xC0\n is an invalid utf-8 sequence puts -nonewline $chan a\nb\nc\xC0\nd\n flush $chan seek $chan 0 | | | 9732 9733 9734 9735 9736 9737 9738 9739 9740 9741 9742 9743 9744 9745 9746 | } -setup { set chan [file tempfile] fconfigure $chan -encoding binary # \xC0\n is an invalid utf-8 sequence puts -nonewline $chan a\nb\nc\xC0\nd\n flush $chan seek $chan 0 fconfigure $chan -encoding utf-8 -buffering none \ -translation auto -profile strict } -body { set res [gets $chan] lappend res [gets $chan] lappend res [catch {gets $chan} msg data] $msg [dict exists $data -data] chan configure $chan -profile tcl8 lappend res [gets $chan] |
︙ | ︙ |
Changes to tests/ioCmd.test.
︙ | ︙ | |||
44 45 46 47 48 49 50 | list [catch {puts stdin hello} msg] $msg } {1 {channel "stdin" wasn't opened for writing}} set path(test1) [makeFile {} test1] test iocmd-1.6 {puts command} { set f [open $path(test1) w] | | | | 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 | list [catch {puts stdin hello} msg] $msg } {1 {channel "stdin" wasn't opened for writing}} set path(test1) [makeFile {} test1] test iocmd-1.6 {puts command} { set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f foobar close $f file size $path(test1) } 6 test iocmd-1.7 {puts command} { set f [open $path(test1) w] fconfigure $f -translation lf puts $f foobar close $f file size $path(test1) } 7 test iocmd-1.8 {puts command} { set f [open $path(test1) w] fconfigure $f -translation binary |
︙ | ︙ | |||
237 238 239 240 241 242 243 | test iocmd-8.6 {fconfigure command} -returnCodes error -body { fconfigure stdin -translation froboz } -result {bad value for -translation: must be one of auto, binary, cr, lf, crlf, or platform} test iocmd-8.7 {fconfigure command} -setup { file delete $path(test1) } -body { set f1 [open $path(test1) w] | | | | 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 | test iocmd-8.6 {fconfigure command} -returnCodes error -body { fconfigure stdin -translation froboz } -result {bad value for -translation: must be one of auto, binary, cr, lf, crlf, or platform} test iocmd-8.7 {fconfigure command} -setup { file delete $path(test1) } -body { set f1 [open $path(test1) w] fconfigure $f1 -translation lf -encoding utf-16 fconfigure $f1 } -cleanup { catch {close $f1} } -result {-blocking 1 -buffering full -buffersize 4096 -encoding utf-16 -eofchar {} -profile strict -translation lf} test iocmd-8.8 {fconfigure command} -setup { file delete $path(test1) set x {} } -body { set f1 [open $path(test1) w] fconfigure $f1 -translation lf -buffering line -buffersize 3030 \ -encoding utf-16 -profile tcl8 lappend x [fconfigure $f1 -buffering] lappend x [fconfigure $f1] } -cleanup { catch {close $f1} } -result {line {-blocking 1 -buffering line -buffersize 3030 -encoding utf-16 -eofchar {} -profile tcl8 -translation lf}} test iocmd-8.9 {fconfigure command} -setup { file delete $path(test1) |
︙ | ︙ | |||
442 443 444 445 446 447 448 | } -returnCodes error -result {(?i)couldn't open ".*test3": no such file or directory} # # Test 13.4 relies on assigning the same channel name twice. # test iocmd-12.4 {POSIX open access modes: WRONLY} {unix} { file delete $path(test3) set f [open $path(test3) w] | | | | | 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 | } -returnCodes error -result {(?i)couldn't open ".*test3": no such file or directory} # # Test 13.4 relies on assigning the same channel name twice. # test iocmd-12.4 {POSIX open access modes: WRONLY} {unix} { file delete $path(test3) set f [open $path(test3) w] fconfigure $f puts $f xyzzy close $f set f [open $path(test3) WRONLY] fconfigure $f puts -nonewline $f "ab" seek $f 0 current set x [list [catch {gets $f} msg] $msg] close $f set f [open $path(test3) r] fconfigure $f lappend x [gets $f] close $f set y [list 1 [format "channel \"%s\" wasn't opened for reading" $f] abzzy] string compare $x $y } 0 test iocmd-12.5 {POSIX open access modes: RDWR} -match regexp -body { file delete $path(test3) |
︙ | ︙ | |||
1388 1389 1390 1391 1392 1393 1394 | set res {} proc foo args {oninit; onfinal; track; note MUST_NOT_HAPPEN; return} set c [chan create {r w} foo] note [fconfigure $c] close $c rename foo {} set res | | | | | 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 | set res {} proc foo args {oninit; onfinal; track; note MUST_NOT_HAPPEN; return} set c [chan create {r w} foo] note [fconfigure $c] close $c rename foo {} set res } -result {{-blocking 1 -buffering full -buffersize 4096 -encoding * -profile * -translation {auto *}}} test iocmd-25.2 {chan configure, cgetall, no options} -match glob -body { set res {} proc foo args {oninit cget cgetall; onfinal; track; return ""} set c [chan create {r w} foo] note [fconfigure $c] close $c rename foo {} set res } -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -profile * -translation {auto *}}} test iocmd-25.3 {chan configure, cgetall, regular result} -match glob -body { set res {} proc foo args { oninit cget cgetall; onfinal; track return {-bar foo -snarf x} } set c [chan create {r w} foo] note [fconfigure $c] close $c rename foo {} set res } -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -profile * -translation {auto *} -bar foo -snarf x}} test iocmd-25.4 {chan configure, cgetall, bad result, list of uneven length} -match glob -body { set res {} proc foo {args} { oninit cget cgetall; onfinal; track return "-bar" } set c [chan create {r w} foo] |
︙ | ︙ | |||
2973 2974 2975 2976 2977 2978 2979 | note [fconfigure $c] close $c notes } c] rename foo {} set res } -constraints {testchannel thread} \ | | | | | 2973 2974 2975 2976 2977 2978 2979 2980 2981 2982 2983 2984 2985 2986 2987 2988 2989 2990 2991 2992 2993 2994 2995 2996 2997 2998 2999 3000 3001 3002 3003 3004 3005 3006 3007 3008 3009 3010 3011 3012 3013 3014 3015 3016 | note [fconfigure $c] close $c notes } c] rename foo {} set res } -constraints {testchannel thread} \ -result {{-blocking 1 -buffering full -buffersize 4096 -encoding * * -translation {auto *}}} test iocmd.tf-25.2 {chan configure, cgetall, no options} -match glob -body { set res {} proc foo {args} {oninit cget cgetall; onfinal; track; return ""} set c [chan create {r w} foo] notes [inthread $c { note [fconfigure $c] close $c notes } c] rename foo {} set res } -constraints {testchannel thread} \ -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * * -translation {auto *}}} test iocmd.tf-25.3 {chan configure, cgetall, regular result} -match glob -body { set res {} proc foo {args} { oninit cget cgetall; onfinal; track return "-bar foo -snarf x" } set c [chan create {r w} foo] notes [inthread $c { note [fconfigure $c] close $c notes } c] rename foo {} set res } -constraints {testchannel thread} \ -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * * -translation {auto *} -bar foo -snarf x}} test iocmd.tf-25.4 {chan configure, cgetall, bad result, list of uneven length} -match glob -body { set res {} proc foo {args} { oninit cget cgetall; onfinal; track return "-bar" } set c [chan create {r w} foo] |
︙ | ︙ |
Changes to tests/macOSXFCmd.test.
︙ | ︙ | |||
100 101 102 103 104 105 106 | [file delete -force -- foo.test] } {0 {} 0 1 {}} test macOSXFCmd-2.7 {MacOSXSetFileAttribute - rsrclength} {macosxFileAttr notRoot nonPortable} { catch {file delete -force -- foo.test} close [open foo.test w] catch { set f [open foo.test/..namedfork/rsrc w] | | | | 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 | [file delete -force -- foo.test] } {0 {} 0 1 {}} test macOSXFCmd-2.7 {MacOSXSetFileAttribute - rsrclength} {macosxFileAttr notRoot nonPortable} { catch {file delete -force -- foo.test} close [open foo.test w] catch { set f [open foo.test/..namedfork/rsrc w] fconfigure $f -translation lf puts -nonewline $f "foo" close $f } list [catch {file attributes foo.test -rsrclength} msg] $msg \ [catch {file attributes foo.test -rsrclength 0} msg] $msg \ [catch {file attributes foo.test -rsrclength} msg] $msg \ [file delete -force -- foo.test] } {0 3 0 {} 0 0 {}} test macOSXFCmd-3.1 {MacOSXCopyFileAttributes} {macosxFileAttr notRoot} { catch {file delete -force -- foo.test} catch {file delete -force -- bar.test} close [open foo.test w] catch { file attributes foo.test -creator FOOC -type FOOT -hidden 1 set f [open foo.test/..namedfork/rsrc w] fconfigure $f -translation lf puts -nonewline $f "foo" close $f file copy foo.test bar.test } list [catch {file attributes bar.test -creator} msg] $msg \ [catch {file attributes bar.test -type} msg] $msg \ [catch {file attributes bar.test -hidden} msg] $msg \ |
︙ | ︙ |