| ︙ | | |
35
36
37
38
39
40
41
42
43
44
45
46
47
48
|
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
|
+
|
testConstraint fileevent [llength [info commands fileevent]]
testConstraint fcopy [llength [info commands fcopy]]
testConstraint testfevent [llength [info commands testfevent]]
testConstraint testchannelevent [llength [info commands testchannelevent]]
testConstraint testmainthread [llength [info commands testmainthread]]
testConstraint testthread [llength [info commands testthread]]
testConstraint testobj [llength [info commands testobj]]
testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}]
# You need a *very* special environment to do some tests. In
# particular, many file systems do not support large-files...
testConstraint largefileSupport [expr {$::tcl_platform(os) ne "Darwin"}]
# some tests can only be run is umask is 2
# if "umask" cannot be run, the tests will be skipped.
|
| ︙ | | |
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
|
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
|
-
-
-
-
+
+
+
+
|
test io-1.8 {Tcl_WriteChars: WriteChars} {
# This test written for SF bug #506297.
#
# Executing this test without the fix for the referenced bug
# applied to tcl will cause tcl, more specifically WriteChars, to
# go into an infinite loop.
set f [open $path(test2) w]
fconfigure $f -encoding iso2022-jp
puts -nonewline $f [format %s%c [string repeat " " 4] 12399]
close $f
set f [open $path(test2) w]
fconfigure $f -encoding iso2022-jp
puts -nonewline $f [format %s%c [string repeat " " 4] 12399]
close $f
contents $path(test2)
} " \x1b\$B\$O\x1b(B"
test io-1.9 {Tcl_WriteChars: WriteChars} {
# When closing a channel with an encoding that appends
# escape bytes, check for the case where the escape
# bytes overflow the current IO buffer. The bytes
|
| ︙ | | |
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
|
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
|
-
+
|
lappend sizes [file size $path(test2)]
set sizes
} {19 19 19 19 19}
test io-2.1 {WriteBytes} {
# loop until all bytes are written
set f [open $path(test1) w]
fconfigure $f -encoding binary -buffersize 16 -translation crlf
puts $f "abcdefghijklmnopqrstuvwxyz"
close $f
contents $path(test1)
} "abcdefghijklmnopqrstuvwxyz\r\n"
test io-2.2 {WriteBytes: savedLF > 0} {
|
| ︙ | | |
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
|
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
|
-
+
-
+
|
close $f
lappend x [contents $path(test1)]
} [list "123456789012345\r" "123456789012345\r\n12"]
test io-2.3 {WriteBytes: flush on line} {
# Tcl "line" buffering has weird behavior: if current buffer contains
# a \n, entire buffer gets flushed. Logical behavior would be to flush
# only up to the \n.
set f [open $path(test1) w]
fconfigure $f -encoding binary -buffering line -translation crlf
puts -nonewline $f "\n12"
set x [contents $path(test1)]
close $f
set x
} "\r\n12"
test io-2.4 {WriteBytes: reset sawLF after each buffer} {
set f [open $path(test1) w]
fconfigure $f -encoding binary -buffering line -translation lf \
-buffersize 16
puts -nonewline $f "abcdefg\nhijklmnopqrstuvwxyz"
set x [list [contents $path(test1)]]
close $f
lappend x [contents $path(test1)]
} [list "abcdefg\nhijklmno" "abcdefg\nhijklmnopqrstuvwxyz"]
test io-3.1 {WriteChars: compatibility with WriteBytes} {
# loop until all bytes are written
set f [open $path(test1) w]
fconfigure $f -encoding ascii -buffersize 16 -translation crlf
puts $f "abcdefghijklmnopqrstuvwxyz"
close $f
contents $path(test1)
} "abcdefghijklmnopqrstuvwxyz\r\n"
test io-3.2 {WriteChars: compatibility with WriteBytes: savedLF > 0} {
|
| ︙ | | |
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
|
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
|
-
+
-
+
-
+
|
close $f
lappend x [contents $path(test1)]
} [list "123456789012345\r" "123456789012345\r\n12"]
test io-3.3 {WriteChars: compatibility with WriteBytes: flush on line} {
# Tcl "line" buffering has weird behavior: if current buffer contains
# a \n, entire buffer gets flushed. Logical behavior would be to flush
# only up to the \n.
set f [open $path(test1) w]
fconfigure $f -encoding ascii -buffering line -translation crlf
puts -nonewline $f "\n12"
set x [contents $path(test1)]
close $f
set x
} "\r\n12"
test io-3.4 {WriteChars: loop over stage buffer} {
# stage buffer maps to more than can be queued at once.
set f [open $path(test1) w]
fconfigure $f -encoding jis0208 -buffersize 16
fconfigure $f -encoding jis0208 -buffersize 16
puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
set x [list [contents $path(test1)]]
close $f
lappend x [contents $path(test1)]
} [list "!)!)!)!)!)!)!)!)" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]
test io-3.5 {WriteChars: saved != 0} {
# Bytes produced by UtfToExternal from end of last channel buffer
# had to be moved to beginning of next channel buffer to preserve
# requested buffersize.
set f [open $path(test1) w]
fconfigure $f -encoding jis0208 -buffersize 17
fconfigure $f -encoding jis0208 -buffersize 17
puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
set x [list [contents $path(test1)]]
close $f
lappend x [contents $path(test1)]
} [list "!)!)!)!)!)!)!)!)!" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]
test io-3.6 {WriteChars: (stageRead + dstWrote == 0)} {
# One incomplete UTF-8 character at end of staging buffer. Backup
|
| ︙ | | |
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
|
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
|
-
+
|
# When translating UTF-8 to external, the produced bytes went past end
# of the channel buffer. This is done purpose -- we then truncate the
# bytes at the end of the partial character to preserve the requested
# blocksize on flush. The truncated bytes are moved to the beginning
# of the next channel buffer.
set f [open $path(test1) w]
fconfigure $f -encoding jis0208 -buffersize 17
fconfigure $f -encoding jis0208 -buffersize 17
puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
set x [list [contents $path(test1)]]
close $f
lappend x [contents $path(test1)]
} [list "!)!)!)!)!)!)!)!)!" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]
test io-3.8 {WriteChars: reset sawLF after each buffer} {
set f [open $path(test1) w]
|
| ︙ | | |
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
|
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
|
-
+
|
puts -nonewline $f "12345678901\n456789012345678901234"
close $f
set x [contents $path(test1)]
} "12345678901\r\n456789012345678901234"
test io-5.1 {CheckFlush: not full} {
set f [open $path(test1) w]
fconfigure $f
fconfigure $f
puts -nonewline $f "12345678901234567890"
set x [list [contents $path(test1)]]
close $f
lappend x [contents $path(test1)]
} [list "" "12345678901234567890"]
test io-5.2 {CheckFlush: full} {
set f [open $path(test1) w]
|
| ︙ | | |
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
|
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
|
-
+
|
close $f
set x
} [list 2 "\u4e00\u4e01"]
set a "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"
append a $a
append a $a
test io-6.6 {Tcl_GetsObj: loop test} {
# if (dst >= dstEnd)
# if (dst >= dstEnd)
set f [open $path(test1) w]
puts $f $a
puts $f hi
close $f
set f [open $path(test1)]
set x [list [gets $f line] $line]
|
| ︙ | | |
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
|
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
|
-
+
-
-
+
+
|
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')
# 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]]
|
| ︙ | | |
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
|
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
|
-
+
-
+
-
+
|
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]
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 openpipe fileevent} {
# not (*eol == '\n')
# 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]
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"]
|
| ︙ | | |
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
|
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
|
-
+
-
+
-
+
-
-
+
+
-
+
|
puts -nonewline $f "123456789012345\r\nabcdefghijklmnopq"
close $f
set f [open $path(test1)]
fconfigure $f -translation auto -buffersize 16
set x [list [gets $f] [testchannel inputbuffered $f]]
close $f
set x
} [list "123456789012345" 15]
} [list "123456789012345" 15]
test io-6.48 {Tcl_GetsObj: auto mode: \r at end of buffer, no more avail} {testchannel} {
# PeekAhead() did not get any, so (eol >= 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 auto -buffersize 16
set x [list [gets $f] [testchannel queuedcr $f]]
close $f
set x
} [list "123456789012345" 1]
test io-6.49 {Tcl_GetsObj: auto mode: \r followed by \n} {testchannel} {
# if (*eol == '\n') {skip++}
set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "123456\r\n78901"
close $f
set f [open $path(test1)]
set x [list [gets $f] [testchannel queuedcr $f] [tell $f] [gets $f]]
close $f
set x
} [list "123456" 0 8 "78901"]
test io-6.50 {Tcl_GetsObj: auto mode: \r not followed by \n} {testchannel} {
# not (*eol == '\n')
# not (*eol == '\n')
set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "123456\r78901"
close $f
set f [open $path(test1)]
set x [list [gets $f] [testchannel queuedcr $f] [tell $f] [gets $f]]
close $f
set x
} [list "123456" 0 7 "78901"]
test io-6.51 {Tcl_GetsObj: auto mode: \n} {
# else if (*eol == '\n') {goto gotoeol;}
set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "123456\n78901"
close $f
set f [open $path(test1)]
set x [list [gets $f] [tell $f] [gets $f]]
close $f
|
| ︙ | | |
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
|
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
|
-
+
|
fconfigure $f -encoding shiftjis -buffersize 16
set x [gets $f]
close $f
set x
} "1234567890123\uff10\uff11\uff12\uff13\uff14"
test io-7.2 {FilterInputBytes: split up character in middle of buffer} {
# (bufPtr->nextAdded < bufPtr->bufLength)
set f [open $path(test1) w]
fconfigure $f -encoding binary
puts -nonewline $f "1234567890\n123\x82\x4f\x82\x50\x82"
close $f
set f [open $path(test1)]
fconfigure $f -encoding shiftjis
set x [list [gets $f line] $line [eof $f]]
|
| ︙ | | |
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
|
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
|
-
+
-
+
|
# "${a}\r" was converted in one operation (because ENCODING_LINESIZE
# is 30). To check if "\n" follows, calls PeekAhead and determines
# that cached data is available in buffer w/o having to call driver.
set x [gets $f]
close $f
set x
set x
} $a
unset a
test io-8.5 {PeekAhead: don't peek if last read was short} {stdio testchannel openpipe fileevent} {
# (bufPtr->nextAdded < bufPtr->length)
set f [open "|[list [interpreter] $path(cat)]" w+]
fconfigure $f -translation {auto binary}
puts -nonewline $f "abcdefghijklmno\r"
flush $f
# here
set x [list [gets $f line] $line [testchannel queuedcr $f]]
close $f
set x
} {15 abcdefghijklmno 1}
test io-8.6 {PeekAhead: change to non-blocking mode} {stdio testchannel openpipe fileevent} {
# ((chanPtr->flags & CHANNEL_NONBLOCKING) == 0)
# ((chanPtr->flags & CHANNEL_NONBLOCKING) == 0)
set f [open "|[list [interpreter] $path(cat)]" w+]
fconfigure $f -translation {auto binary} -buffersize 16
puts -nonewline $f "abcdefghijklmno\r"
flush $f
# here
set x [list [gets $f line] $line [testchannel queuedcr $f]]
|
| ︙ | | |
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
|
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
|
-
+
-
+
-
+
|
set f [open $path(test1)]
fconfigure $f -translation crlf
set x [read $f]
close $f
set x
} "abcd\ndef\n"
test io-13.3 {TranslateInputEOL: crlf mode: naked cr} {
# (src >= srcMax)
# (src >= srcMax)
set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "abcd\r\ndef\r"
close $f
set f [open $path(test1)]
fconfigure $f -translation crlf
set x [read $f]
close $f
set x
} "abcd\ndef\r"
test io-13.4 {TranslateInputEOL: crlf mode: cr followed by not \n} {
# (src >= srcMax)
# (src >= srcMax)
set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "abcd\r\ndef\rfgh"
close $f
set f [open $path(test1)]
fconfigure $f -translation crlf
set x [read $f]
close $f
set x
} "abcd\ndef\rfgh"
test io-13.5 {TranslateInputEOL: crlf mode: naked lf} {
# (src >= srcMax)
# (src >= srcMax)
set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "abcd\r\ndef\nfgh"
close $f
set f [open $path(test1)]
fconfigure $f -translation crlf
|
| ︙ | | |
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
|
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
|
-
+
|
set f [open $path(test1)]
fconfigure $f -translation auto
set x [read $f]
close $f
set x
} "abcd\ndef"
test io-13.10 {TranslateInputEOL: auto mode: \n} {
# not (*src == '\r')
# not (*src == '\r')
set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "abcd\ndef"
close $f
set f [open $path(test1)]
fconfigure $f -translation auto
|
| ︙ | | |
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
|
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
|
-
+
|
encoding system ascii
set f [open $path(test1) w]
set x [fconfigure $f -encoding]
close $f
encoding system $old
close $a
set x
} {ascii}
} {ascii}
test io-20.2 {Tcl_CreateChannel: initial settings} {win} {
set f [open $path(test1) w+]
set x [list [fconfigure $f -eofchar] [fconfigure $f -translation]]
close $f
set x
} [list [list \x1a ""] {auto crlf}]
test io-20.3 {Tcl_CreateChannel: initial settings} {unix} {
|
| ︙ | | |
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
|
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
|
-
+
|
test io-26.1 {Tcl_GetChannelInstanceData} {stdio openpipe} {
# "pid" command uses Tcl_GetChannelInstanceData
# Don't care what pid is (but must be a number), just want to exercise it.
set f [open "|[list [interpreter] << exit]"]
expr [pid $f]
close $f
} {}
} {}
# Test flushing. The functions tested here are FlushChannel.
test io-27.1 {FlushChannel, no output buffered} {
file delete $path(test1)
set f [open $path(test1) w]
flush $f
|
| ︙ | | |
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
|
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
|
-
+
|
close $f
lappend l [file size $path(test1)]
set l
} {0 60 72}
set path(pipe) [makeFile {} pipe]
set path(output) [makeFile {} output]
test io-27.6 {FlushChannel, async flushing, async close} \
{stdio asyncPipeClose openpipe} {
{stdio asyncPipeClose openpipe knownMsvcBug} {
# 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 {
|
| ︙ | | |
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
|
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
|
-
+
|
# allow a little time for the background process to close.
# otherwise, the following test fails on the [file delete $path(output)
# on Windows because a process still has the file open.
after 100 set v 1; vwait v
set result
} ok
test io-29.32 {Tcl_WriteChars, background flush to slow reader} \
{stdio asyncPipeClose openpipe} {
{stdio asyncPipeClose openpipe knownMsvcBug} {
# 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}
|
| ︙ | | |
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
|
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
|
-
+
|
fconfigure $f -translation cr
puts $f hello\nthere\nand\nhere
close $f
set f [open $path(test1) r]
fconfigure $f -translation crlf
set x [read $f]
close $f
set x
set x
} "hello\rthere\rand\rhere\r"
test io-30.7 {Tcl_Write crlf, Tcl_Read crlf} {
file delete $path(test1)
set f [open $path(test1) w]
fconfigure $f -translation crlf
puts $f hello\nthere\nand\nhere
close $f
|
| ︙ | | |
3956
3957
3958
3959
3960
3961
3962
3963
3964
3965
3966
3967
3968
3969
3970
|
3957
3958
3959
3960
3961
3962
3963
3964
3965
3966
3967
3968
3969
3970
3971
|
-
+
|
set line "123456789ABCDE" ;# 14 char plus crlf
puts -nonewline $f x ;# shift crlf across block boundary
for {set i 0} {$i < 700} {incr i} {
puts $f $line
}
close $f
set f [open $path(test1) r]
fconfigure $f -translation crlf
fconfigure $f -translation crlf
set c ""
while {[gets $f line] >= 0} {
append c $line\n
}
close $f
string length $c
} [expr 700*15+1]
|
| ︙ | | |
5438
5439
5440
5441
5442
5443
5444
5445
5446
5447
5448
5449
5450
5451
5452
|
5439
5440
5441
5442
5443
5444
5445
5446
5447
5448
5449
5450
5451
5452
5453
|
-
+
|
set x [fconfigure $f -buffersize]
close $f
set x
} 40000
test io-39.14 {Tcl_SetChannelOption: -encoding, binary & utf-8} {
file delete $path(test1)
set f [open $path(test1) w]
fconfigure $f -encoding {}
fconfigure $f -encoding {}
puts -nonewline $f \xe7\x89\xa6
close $f
set f [open $path(test1) r]
fconfigure $f -encoding utf-8
set x [read $f]
close $f
set x
|
| ︙ | | |
8531
8532
8533
8534
8535
8536
8537
8538
8539
8540
8541
8542
8543
8544
8545
8546
8547
8548
8549
|
8532
8533
8534
8535
8536
8537
8538
8539
8540
8541
8542
8543
8544
8545
8546
8547
8548
8549
8550
|
-
+
-
+
|
test io-74.1 {[104f2885bb] improper cache validity check} -setup {
set fn [makeFile {} io-74.1]
set rfd [open $fn r]
testobj freeallvars
interp create slave
} -constraints testobj -body {
teststringobj set 1 [string range $rfd 0 end]
read [teststringobj get 1]
read [teststringobj get 1]
testobj duplicate 1 2
interp transfer {} $rfd slave
catch {read [teststringobj get 1]}
read [teststringobj get 2]
read [teststringobj get 2]
} -cleanup {
interp delete slave
testobj freeallvars
removeFile io-74.1
} -returnCodes error -match glob -result {can not find channel named "*"}
# ### ### ### ######### ######### #########
|
| ︙ | | |