| ︙ | | |
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
|
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
|
-
-
+
+
|
close $f
set path(cat) [makeFile {
set f stdin
if {$argv != ""} {
set f [open [lindex $argv 0]]
}
fconfigure $f -encoding binary -translation lf -blocking 0 -eofchar \x1A
fconfigure stdout -encoding binary -translation lf -buffering none
fconfigure $f -translation binary -blocking 0 -eofchar \x1A
fconfigure stdout -translation binary -buffering none
fileevent $f readable "foo $f"
proc foo {f} {
set x [read $f]
catch {puts -nonewline $x}
if {[eof $f]} {
close $f
exit 0
|
| ︙ | | |
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
|
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
|
-
+
|
test io-1.5 {Tcl_WriteChars: CheckChannelErrors} {emptyTest} {
# no test, need to cause an async error.
} {}
set path(test1) [makeFile {} test1]
test io-1.6 {Tcl_WriteChars: WriteBytes} {
set f [open $path(test1) w]
fconfigure $f -encoding binary
fconfigure $f -translation binary
puts -nonewline $f "a\x4D\x00"
close $f
contents $path(test1)
} "a\x4D\x00"
test io-1.7 {Tcl_WriteChars: WriteChars} {
set f [open $path(test1) w]
fconfigure $f -encoding shiftjis
|
| ︙ | | |
242
243
244
245
246
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
286
287
|
242
243
244
245
246
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
286
|
-
+
-
+
-
+
-
+
-
|
testreadwrite 0xffffffff
} -result 1
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
fconfigure $f -translation binary -buffersize 16 -translation crlf
puts $f "abcdefghijklmnopqrstuvwxyz"
close $f
contents $path(test1)
} "abcdefghijklmnopqrstuvwxyz\r\n"
test io-2.2 {WriteBytes: savedLF > 0} {
# After flushing buffer, there was a \n left over from the last
# \n -> \r\n expansion. It gets stuck at beginning of this buffer.
set f [open $path(test1) w]
fconfigure $f -encoding binary -buffersize 16 -translation crlf
fconfigure $f -translation binary -buffersize 16 -translation crlf
puts -nonewline $f "123456789012345\n12"
set x [list [contents $path(test1)]]
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
fconfigure $f -translation 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 \
fconfigure $f -translation binary -buffering line -buffersize 16
-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-2.5 {WriteBytes: large file (> INT_MAX). Bug 3d01d51bc4} -constraints {
pointerIs64bit perf
|
| ︙ | | |
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
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
1223
1224
|
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
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
1223
|
-
+
-
+
-
+
-
+
|
close $f
set x
} "123456789012301234"
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
fconfigure $f -translation binary
puts -nonewline $f "1234567890\n123\x82\x4F\x82\x50\x82"
close $f
set f [open $path(test1)]
fconfigure $f -encoding shiftjis -profile tcl8
set x [list [gets $f line] $line [eof $f]]
close $f
set x
} [list 10 "1234567890" 0]
test io-7.3 {FilterInputBytes: split up character at EOF} {testchannel} {
set f [open $path(test1) w]
fconfigure $f -encoding binary
fconfigure $f -translation binary
puts -nonewline $f "1234567890123\x82\x4F\x82\x50\x82"
close $f
set f [open $path(test1)]
fconfigure $f -encoding shiftjis -profile tcl8
set x [list [gets $f line] $line]
lappend x [tell $f] [testchannel inputbuffered $f] [eof $f]
lappend x [gets $f line] $line
close $f
set x
} [list 16 "123456789012301\x82" 18 0 1 -1 ""]
test io-7.4 {FilterInputBytes: recover from split up character} {stdio fileevent} {
set f [open "|[list [interpreter] $path(cat)]" w+]
fconfigure $f -encoding binary -buffering none
fconfigure $f -translation binary -buffering none
puts -nonewline $f "1234567890123\x82\x4F\x82\x50\x82"
fconfigure $f -encoding shiftjis -blocking 0
fileevent $f read [namespace code "ready $f"]
variable x {}
proc ready {f} {
variable x
lappend x [gets $f line] $line [fblocked $f]
}
vwait [namespace which -variable x]
fconfigure $f -encoding binary -blocking 1
fconfigure $f -translation binary -blocking 1
puts $f "\x51\x82\x52"
fconfigure $f -encoding shiftjis
vwait [namespace which -variable x]
close $f
set x
} [list -1 "" 1 17 "12345678901230123" 0]
|
| ︙ | | |
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
|
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
|
-
+
|
# not (bytesLeft == 0)
set f [open $path(test1) w+]
fconfigure $f -translation binary
puts $f "${a}\r\nabcdef"
close $f
set f [open $path(test1)]
fconfigure $f -encoding binary -translation auto
fconfigure $f -translation binary -translation auto
# "${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
|
| ︙ | | |
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
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
|
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
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
|
-
+
-
+
-
+
-
+
|
test io-11.1 {ReadBytes: want to read a lot} {
# ((unsigned) toRead > (unsigned) srcLen)
set f [open $path(test1) w]
puts -nonewline $f abcdefghijkl
close $f
set f [open $path(test1)]
fconfigure $f -encoding binary
fconfigure $f -translation binary
# here
set x [read $f 1000]
close $f
set x
} {abcdefghijkl}
test io-11.2 {ReadBytes: want to read all} {
# ((unsigned) toRead > (unsigned) srcLen)
set f [open $path(test1) w]
puts -nonewline $f abcdefghijkl
close $f
set f [open $path(test1)]
fconfigure $f -encoding binary
fconfigure $f -translation binary
# here
set x [read $f]
close $f
set x
} {abcdefghijkl}
test io-11.3 {ReadBytes: allocate more space} {
# (toRead > length - offset - 1)
set f [open $path(test1) w]
puts -nonewline $f abcdefghijklmnopqrstuvwxyz
close $f
set f [open $path(test1)]
fconfigure $f -buffersize 16 -encoding binary
fconfigure $f -buffersize 16 -translation binary
# here
set x [read $f]
close $f
set x
} {abcdefghijklmnopqrstuvwxyz}
test io-11.4 {ReadBytes: EOF char found} {
# (TranslateInputEOL() != 0)
set f [open $path(test1) w]
puts $f abcdefghijklmnopqrstuvwxyz
close $f
set f [open $path(test1)]
fconfigure $f -eofchar m -encoding binary
fconfigure $f -translation binary -eofchar m
# here
set x [list [read $f] [eof $f] [read $f] [eof $f]]
close $f
set x
} [list "abcdefghijkl" 1 "" 1]
test io-12.1 {ReadChars: want to read a lot} {
|
| ︙ | | |
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
|
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
|
-
+
-
+
-
+
|
close $f
set x
} {abcdefghijklmnopqrstuvwxyz}
test io-12.4 {ReadChars: split-up char} {stdio testchannel fileevent} {
# (srcRead == 0)
set f [open "|[list [interpreter] $path(cat)]" w+]
fconfigure $f -encoding binary -buffering none -buffersize 16
fconfigure $f -translation binary -buffering none -buffersize 16
puts -nonewline $f "123456789012345\x96"
fconfigure $f -encoding shiftjis -blocking 0
fileevent $f read [namespace code "ready $f"]
proc ready {f} {
variable x
lappend x [read $f] [testchannel inputbuffered $f]
}
variable x {}
fconfigure $f -encoding shiftjis
vwait [namespace which -variable x]
fconfigure $f -encoding binary -blocking 1
fconfigure $f -translation binary -blocking 1
puts -nonewline $f "\x7B"
after 500 ;# Give the cat process time to catch up
fconfigure $f -encoding shiftjis -blocking 0
vwait [namespace which -variable x]
close $f
set x
} [list "123456789012345" 1 "本" 0]
test io-12.5 {ReadChars: fileevents on partial characters} {stdio fileevent} {
set path(test1) [makeFile {
fconfigure stdout -encoding binary -buffering none
fconfigure stdout -translation binary -buffering none
gets stdin; puts -nonewline "\xE7"
gets stdin; puts -nonewline "\x89"
gets stdin; puts -nonewline "\xA6"
} test1]
set f [open "|[list [interpreter] $path(test1)]" r+]
fileevent $f readable [namespace code {
lappend x [read $f]
|
| ︙ | | |
5012
5013
5014
5015
5016
5017
5018
5019
5020
5021
5022
5023
5024
5025
5026
|
5011
5012
5013
5014
5015
5016
5017
5018
5019
5020
5021
5022
5023
5024
5025
|
-
+
|
lappend l [tell $f]
close $f
set l
} {29 39 40 447}
test io-34.21 {Tcl_Seek and Tcl_Tell on large files} {largefileSupport extensive} {
file delete $path(test3)
set f [open $path(test3) w]
fconfigure $f -encoding binary
fconfigure $f -translation binary
set l ""
lappend l [tell $f]
puts -nonewline $f abcdef
lappend l [tell $f]
flush $f
lappend l [tell $f]
# 4GB offset!
|
| ︙ | | |
5403
5404
5405
5406
5407
5408
5409
5410
5411
5412
5413
5414
5415
5416
5417
5418
5419
|
5402
5403
5404
5405
5406
5407
5408
5409
5410
5411
5412
5413
5414
5415
5416
5417
5418
|
-
+
-
+
|
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
chan configure $f1 -translation binary
puts $f1 {
chan configure stdout -encoding binary -translation lf
chan configure stdout -translation binary
puts hello_from_pipe
}
flush $f1
gets $f1
fconfigure $f1 -blocking off -buffering full
puts $f1 {puts hello}
set x ""
|
| ︙ | | |
5748
5749
5750
5751
5752
5753
5754
5755
5756
5757
5758
5759
5760
5761
5762
5763
5764
5765
5766
5767
5768
5769
5770
5771
5772
5773
5774
|
5747
5748
5749
5750
5751
5752
5753
5754
5755
5756
5757
5758
5759
5760
5761
5762
5763
5764
5765
5766
5767
5768
5769
5770
5771
5772
5773
|
-
+
-
+
|
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 -translation binary
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
} 牦
test io-39.15 {Tcl_SetChannelOption: -encoding, binary & utf-8} {
file delete $path(test1)
set f [open $path(test1) w]
fconfigure $f -encoding binary
fconfigure $f -translation binary
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
|
| ︙ | | |
5785
5786
5787
5788
5789
5790
5791
5792
5793
5794
5795
5796
5797
5798
5799
5800
5801
5802
5803
5804
5805
5806
5807
5808
5809
5810
5811
5812
|
5784
5785
5786
5787
5788
5789
5790
5791
5792
5793
5794
5795
5796
5797
5798
5799
5800
5801
5802
5803
5804
5805
5806
5807
5808
5809
5810
5811
|
-
+
-
+
|
set f [open $path(test1) w]
fconfigure $f -e foobar
} -cleanup {
close $f
} -returnCodes 1 -match glob -result {bad option "-e": should be one of *}
test io-39.17 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_DATA} {stdio fileevent} {
set f [open "|[list [interpreter] $path(cat)]" r+]
fconfigure $f -encoding binary
fconfigure $f -encoding iso8859-1
puts -nonewline $f "\xE7"
flush $f
fconfigure $f -encoding utf-8 -blocking 0
variable x {}
fileevent $f readable [namespace code { lappend x [read $f] }]
vwait [namespace which -variable x]
after 300 [namespace code { lappend x timeout }]
vwait [namespace which -variable x]
fconfigure $f -encoding utf-8
vwait [namespace which -variable x]
after 300 [namespace code { lappend x timeout }]
vwait [namespace which -variable x]
fconfigure $f -encoding binary
fconfigure $f -translation binary
vwait [namespace which -variable x]
after 300 [namespace code { lappend x timeout }]
vwait [namespace which -variable x]
close $f
set x
} "{} timeout {} timeout \xE7 timeout"
test io-39.18 {Tcl_SetChannelOption, setting read mode independently} \
|
| ︙ | | |
7601
7602
7603
7604
7605
7606
7607
7608
7609
7610
7611
7612
7613
7614
7615
7616
7617
7618
7619
7620
7621
7622
7623
7624
7625
7626
7627
7628
7629
7630
7631
7632
7633
7634
|
7600
7601
7602
7603
7604
7605
7606
7607
7608
7609
7610
7611
7612
7613
7614
7615
7616
7617
7618
7619
7620
7621
7622
7623
7624
7625
7626
7627
7628
7629
7630
7631
|
-
-
|
[file size $path(utf8-rp.txt)]
} {3 5 5}
test io-52.10 {TclCopyChannel & encodings} -constraints fcopy -body {
set in [open $path(kyrillic.txt) r]
set out [open $path(utf8-fcopy.txt) w]
fconfigure $in -encoding koi8-r -translation lf
# -translation binary is also -encoding binary
fconfigure $out -translation binary
fcopy $in $out
file size $path(utf8-fcopy.txt)
} -cleanup {
close $in
close $out
} -returnCodes 1 -match glob -result {error writing "*":\
invalid or incomplete multibyte or wide character}
test io-52.11 {TclCopyChannel & encodings} -setup {
set out [open $path(utf8-fcopy.txt) w]
fconfigure $out -encoding utf-8 -translation lf -profile strict
puts $out АА
close $out
} -constraints {fcopy} -body {
set in [open $path(utf8-fcopy.txt) r]
set out [open $path(kyrillic.txt) w]
# -translation binary is also -encoding binary
fconfigure $in -translation binary
fconfigure $out -encoding koi8-r -translation lf -profile strict
catch {fcopy $in $out} cres copts
return $cres
} -cleanup {
if {$in in [chan names]} {
close $in
|
| ︙ | | |
9326
9327
9328
9329
9330
9331
9332
9333
9334
9335
9336
9337
9338
9339
9340
|
9323
9324
9325
9326
9327
9328
9329
9330
9331
9332
9333
9334
9335
9336
9337
|
-
+
|
testobj freeallvars
removeFile io-74.1
} -returnCodes error -match glob -result {can not find channel named "*"}
test io-75.1 {multibyte encoding error read results in raw bytes (-profile tcl8)} -setup {
set fn [makeFile {} io-75.1]
set f [open $fn w+]
fconfigure $f -encoding binary
fconfigure $f -translation binary
# In UTF-8, a byte 0xCx starts a multibyte sequence and must be followed
# by a byte > 0x7F. This is violated to get an invalid sequence.
puts -nonewline $f A\xC0\x40
flush $f
seek $f 0
fconfigure $f -encoding utf-8 -profile tcl8 -buffering none
} -body {
|
| ︙ | | |
9362
9363
9364
9365
9366
9367
9368
9369
9370
9371
9372
9373
9374
9375
9376
9377
9378
9379
9380
9381
9382
9383
9384
9385
9386
9387
9388
9389
9390
9391
9392
9393
9394
9395
9396
9397
9398
9399
9400
9401
9402
9403
9404
9405
9406
9407
9408
9409
9410
9411
9412
9413
9414
9415
9416
9417
9418
9419
9420
9421
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
9473
9474
9475
9476
9477
9478
9479
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
|
9359
9360
9361
9362
9363
9364
9365
9366
9367
9368
9369
9370
9371
9372
9373
9374
9375
9376
9377
9378
9379
9380
9381
9382
9383
9384
9385
9386
9387
9388
9389
9390
9391
9392
9393
9394
9395
9396
9397
9398
9399
9400
9401
9402
9403
9404
9405
9406
9407
9408
9409
9410
9411
9412
9413
9414
9415
9416
9417
9418
9419
9420
9421
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
9473
9474
9475
9476
9477
9478
9479
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
|
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
|
# Incomplete sequence test.
# This error may IMHO only be detected with the close.
# But the read already returns the incomplete sequence.
test io-75.3 {incomplete multibyte encoding read is ignored (-profile tcl8)} -setup {
set fn [makeFile {} io-75.3]
set f [open $fn w+]
fconfigure $f -encoding binary
fconfigure $f -translation binary
puts -nonewline $f "A\xC0"
flush $f
seek $f 0
fconfigure $f -encoding utf-8 -buffering none -profile tcl8
} -body {
set d [read $f]
binary scan $d H* hd
set hd
} -cleanup {
close $f
removeFile io-75.3
} -result 41c0
# As utf-8 has a special treatment in multi-byte decoding, also test another
# one.
test io-75.4 {shiftjis encoding error read results in raw bytes (-profile tcl8)} -setup {
set fn [makeFile {} io-75.4]
set f [open $fn w+]
fconfigure $f -encoding binary
fconfigure $f -translation 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 -buffering none -eofchar "" -translation lf -profile tcl8
} -body {
set d [read $f]
binary scan $d H* hd
set hd
} -cleanup {
close $f
removeFile io-75.4
} -result 4181ff41
test io-75.5 {invalid utf-8 encoding read is ignored (-profile tcl8)} -setup {
set fn [makeFile {} io-75.5]
set f [open $fn w+]
fconfigure $f -encoding binary
fconfigure $f -translation binary
puts -nonewline $f A\x81
flush $f
seek $f 0
fconfigure $f -encoding utf-8 -buffering none -eofchar "" -translation lf -profile tcl8
} -body {
set d [read $f]
binary scan $d H* hd
set hd
} -cleanup {
close $f
removeFile io-75.5
} -result 4181
test io-75.6 {incomplete utf-8 encoding, blocking gets is not ignored (-profile strict)} -setup {
set fn [makeFile {} io-75.6]
set f [open $fn w+]
fconfigure $f -encoding binary
fconfigure $f -translation 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
fconfigure $f -translation 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
fconfigure $f -translation 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
fconfigure $f -translation binary
lappend l [expr {[gets $f] eq "A\xC3B"}]
} -cleanup {
close $f
removeFile io-75.6.2
} -match glob -returnCodes 0 -result {1 0 1}
# TCL ticket c4eb46a196: non blocking case had endless loop, so test it
test io-75.6.3 {invalid utf-8 encoding, non blocking gets is not ignored (-profile strict)} -setup {
set fn [makeFile {} io-75.6.3]
set f [open $fn w+]
fconfigure $f -encoding binary
fconfigure $f -translation 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
fconfigure $f -translation 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 {
|
| ︙ | | |
9515
9516
9517
9518
9519
9520
9521
9522
9523
9524
9525
9526
9527
9528
9529
9530
9531
9532
9533
9534
9535
9536
9537
9538
9539
9540
9541
9542
9543
9544
9545
9546
9547
9548
|
9512
9513
9514
9515
9516
9517
9518
9519
9520
9521
9522
9523
9524
9525
9526
9527
9528
9529
9530
9531
9532
9533
9534
9535
9536
9537
9538
9539
9540
9541
9542
9543
9544
9545
|
-
+
-
+
|
invalid or incomplete multibyte or wide character}
test io-75.7 {
invalid utf-8 encoding read is not ignored (-profile strict)
} -setup {
set fn [makeFile {} io-75.7]
set f [open $fn w+]
fconfigure $f -encoding binary
fconfigure $f -translation 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
} -match glob -result {1 {error reading "file*":\
invalid or incomplete multibyte or wide character} A}
test io-75.8 {invalid utf-8 encoding eof first handling (-profile strict)} -setup {
set fn [makeFile {} io-75.8]
set f [open $fn w+]
fconfigure $f -encoding binary
fconfigure $f -translation binary
# \x81 is invalid in utf-8, but since \x1A comes first, -eofchar takes
# precedence.
puts -nonewline $f A\x1A\x81
flush $f
seek $f 0
fconfigure $f -encoding utf-8 -buffering none -eofchar \x1A \
-translation lf -profile strict
|
| ︙ | | |
9558
9559
9560
9561
9562
9563
9564
9565
9566
9567
9568
9569
9570
9571
9572
|
9555
9556
9557
9558
9559
9560
9561
9562
9563
9564
9565
9566
9567
9568
9569
|
-
+
|
unset f d hd
} -result {41 1 {}}
test io-75.8.eoflater {invalid utf-8 encoding eof after handling (-profile strict)} -setup {
set fn [makeFile {} io-75.8]
set f [open $fn w+]
# This also configures the channel encoding profile as strict.
fconfigure $f -encoding binary
fconfigure $f -translation binary
# \x81 is invalid in utf-8. -eofchar is not detected, because it comes later.
puts -nonewline $f A\x81\x81\x1A
flush $f
seek $f 0
fconfigure $f -encoding utf-8 -buffering none -eofchar \x1A \
-translation lf -profile strict
} -body {
|
| ︙ | | |
9585
9586
9587
9588
9589
9590
9591
9592
9593
9594
9595
9596
9597
9598
9599
|
9582
9583
9584
9585
9586
9587
9588
9589
9590
9591
9592
9593
9594
9595
9596
|
-
+
|
test io-strict-multibyte-eof {
incomplete utf-8 sequence immediately prior to eof character
See issue 25cdcb7e8fb381fb
} -setup {
set chan [file tempfile];
fconfigure $chan -encoding binary
fconfigure $chan -translation binary
puts -nonewline $chan \x81\x1A
flush $chan
seek $chan 0
chan configure $chan -encoding utf-8 -profile strict
} -body {
list [catch {read $chan 1} msg data] $msg [dict get $data -data]
} -cleanup {
|
| ︙ | | |
9621
9622
9623
9624
9625
9626
9627
9628
9629
9630
9631
9632
9633
9634
9635
|
9618
9619
9620
9621
9622
9623
9624
9625
9626
9627
9628
9629
9630
9631
9632
|
-
+
|
test io-75.10 {
incomplete multibyte encoding read is not ignored because "binary" sets
profile to strict
} -setup {
set res {}
set fn [makeFile {} io-75.10]
set f [open $fn w+]
fconfigure $f -encoding binary
fconfigure $f -translation binary
puts -nonewline $f A\xC0
flush $f
seek $f 0
fconfigure $f -encoding utf-8 -buffering none
} -body {
catch {read $f} errmsg
lappend res $errmsg
|
| ︙ | | |
9650
9651
9652
9653
9654
9655
9656
9657
9658
9659
9660
9661
9662
9663
9664
|
9647
9648
9649
9650
9651
9652
9653
9654
9655
9656
9657
9658
9659
9660
9661
|
-
+
|
# This may be expected due to special utf-8 handling.
# As utf-8 has a special treatment in multi-byte decoding, also test another
# one.
test io-75.11 {shiftjis encoding error read results in error (strict profile)} -setup {
set fn [makeFile {} io-75.11]
set f [open $fn w+]
fconfigure $f -encoding binary
fconfigure $f -translation 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
|
| ︙ | | |
9676
9677
9678
9679
9680
9681
9682
9683
9684
9685
9686
9687
9688
9689
9690
|
9673
9674
9675
9676
9677
9678
9679
9680
9681
9682
9683
9684
9685
9686
9687
|
-
+
|
test io-75.12 {
invalid utf-8 encoding read is not ignored because setting the encoding to
"binary" also set the profile to strict
} -setup {
set res {}
set fn [makeFile {} io-75.12]
set f [open $fn w+]
fconfigure $f -encoding binary
fconfigure $f -translation 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
|
| ︙ | | |
9703
9704
9705
9706
9707
9708
9709
9710
9711
9712
9713
9714
9715
9716
9717
|
9700
9701
9702
9703
9704
9705
9706
9707
9708
9709
9710
9711
9712
9713
9714
|
-
+
|
test io-75.13 {
In nonblocking mode when there is an encoding error the data that has been
successfully read so far is returned first and then the error is returned
on the next call to [read].
} -setup {
set fn [makeFile {} io-75.13]
set f [open $fn w+]
fconfigure $f -encoding binary
fconfigure $f -translation 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 {
|
| ︙ | | |
9727
9728
9729
9730
9731
9732
9733
9734
9735
9736
9737
9738
9739
9740
9741
|
9724
9725
9726
9727
9728
9729
9730
9731
9732
9733
9734
9735
9736
9737
9738
|
-
+
|
test io-75.14 {
[gets] succesfully returns lines prior to error
invalid utf-8 encoding [gets] continues in non-strict mode after error
} -setup {
set chan [file tempfile]
fconfigure $chan -encoding binary
fconfigure $chan -translation 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 {
|
| ︙ | | |
9755
9756
9757
9758
9759
9760
9761
9762
9763
9764
9765
9766
9767
9768
9769
|
9752
9753
9754
9755
9756
9757
9758
9759
9760
9761
9762
9763
9764
9765
9766
|
-
+
|
test io-75.15 {
invalid utf-8 encoding strict
gets does not hang
gets succeeds for the first two lines
} -setup {
set res {}
set chan [file tempfile]
fconfigure $chan -encoding binary
fconfigure $chan -translation binary
# \xC0\x40 is an invalid utf-8 sequence
puts $chan hello\nAB\nCD\xC0\x40EF\nGHI
seek $chan 0
} -body {
#Now try to read it with [gets]
fconfigure $chan -encoding utf-8 -profile strict
lappend res [gets $chan]
|
| ︙ | | |