| ︙ | | |
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
|
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
|
-
-
+
+
|
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
|
| ︙ | | |
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
|
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
|
-
+
|
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
|
| ︙ | | |
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
288
289
290
291
292
293
|
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
288
289
290
291
292
|
-
+
-
+
-
+
-
+
-
|
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
|
| ︙ | | |
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
1225
1226
1227
1228
1229
1230
|
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
1225
1226
1227
1228
1229
|
-
+
-
+
-
+
-
+
|
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]
|
| ︙ | | |
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
|
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
|
-
+
|
# 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
|
| ︙ | | |
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
1446
1447
1448
1449
1450
1451
|
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
1446
1447
1448
1449
1450
|
-
+
-
+
-
+
-
+
|
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} {
|
| ︙ | | |
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
1517
1518
1519
1520
1521
1522
|
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
1517
1518
1519
1520
1521
|
-
+
-
+
-
+
|
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]
|
| ︙ | | |
5035
5036
5037
5038
5039
5040
5041
5042
5043
5044
5045
5046
5047
5048
5049
|
5034
5035
5036
5037
5038
5039
5040
5041
5042
5043
5044
5045
5046
5047
5048
|
-
+
|
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!
|
| ︙ | | |
5426
5427
5428
5429
5430
5431
5432
5433
5434
5435
5436
5437
5438
5439
5440
5441
5442
|
5425
5426
5427
5428
5429
5430
5431
5432
5433
5434
5435
5436
5437
5438
5439
5440
5441
|
-
+
-
+
|
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 ""
|
| ︙ | | |
5771
5772
5773
5774
5775
5776
5777
5778
5779
5780
5781
5782
5783
5784
5785
5786
5787
5788
5789
5790
5791
5792
5793
5794
5795
5796
5797
|
5770
5771
5772
5773
5774
5775
5776
5777
5778
5779
5780
5781
5782
5783
5784
5785
5786
5787
5788
5789
5790
5791
5792
5793
5794
5795
5796
|
-
+
-
+
|
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
|
| ︙ | | |
5808
5809
5810
5811
5812
5813
5814
5815
5816
5817
5818
5819
5820
5821
5822
5823
5824
5825
5826
5827
5828
5829
5830
5831
5832
5833
5834
5835
|
5807
5808
5809
5810
5811
5812
5813
5814
5815
5816
5817
5818
5819
5820
5821
5822
5823
5824
5825
5826
5827
5828
5829
5830
5831
5832
5833
5834
|
-
+
-
+
|
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} \
|
| ︙ | | |
7558
7559
7560
7561
7562
7563
7564
7565
7566
7567
7568
7569
7570
7571
7572
7573
7574
7575
7576
7577
7578
7579
7580
7581
7582
7583
7584
7585
7586
7587
7588
7589
7590
7591
|
7557
7558
7559
7560
7561
7562
7563
7564
7565
7566
7567
7568
7569
7570
7571
7572
7573
7574
7575
7576
7577
7578
7579
7580
7581
7582
7583
7584
7585
7586
7587
7588
|
-
-
|
[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
|
| ︙ | | |
9313
9314
9315
9316
9317
9318
9319
9320
9321
9322
9323
9324
9325
9326
9327
|
9310
9311
9312
9313
9314
9315
9316
9317
9318
9319
9320
9321
9322
9323
9324
|
-
+
|
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 {
|
| ︙ | | |
9349
9350
9351
9352
9353
9354
9355
9356
9357
9358
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
|
9346
9347
9348
9349
9350
9351
9352
9353
9354
9355
9356
9357
9358
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
|
-
+
-
+
-
+
|
# 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
|
| ︙ | | |
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
9508
9509
9510
9511
9512
9513
9514
9515
9516
|
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
9508
9509
9510
9511
9512
9513
|
-
+
-
+
-
+
-
+
-
+
-
+
|
} -match glob -result {41 1 {error reading "file*":\
invalid or incomplete multibyte or wide character}}
test io-75.6.gets {invalid utf-8 encoding, 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 {
|
| ︙ | | |
9546
9547
9548
9549
9550
9551
9552
9553
9554
9555
9556
9557
9558
9559
9560
|
9543
9544
9545
9546
9547
9548
9549
9550
9551
9552
9553
9554
9555
9556
9557
|
-
+
|
test io-75.7.read {
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 {
|
| ︙ | | |
9600
9601
9602
9603
9604
9605
9606
9607
9608
9609
9610
9611
9612
9613
9614
|
9597
9598
9599
9600
9601
9602
9603
9604
9605
9606
9607
9608
9609
9610
9611
|
-
+
|
test {io-75.8 {incomplete input after eof}} {
incomplete utf-8 char after eof char is not an error (-profile strict)
} -setup {
set hd {}
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 the eof character \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
|
| ︙ | | |
9657
9658
9659
9660
9661
9662
9663
9664
9665
9666
9667
9668
9669
9670
9671
|
9654
9655
9656
9657
9658
9659
9660
9661
9662
9663
9664
9665
9666
9667
9668
|
-
+
|
test {io-75.8 {invalid input before eof}} {
invalid utf-8 encoding eof 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 {
|
| ︙ | | |
9695
9696
9697
9698
9699
9700
9701
9702
9703
9704
9705
9706
9707
9708
9709
|
9692
9693
9694
9695
9696
9697
9698
9699
9700
9701
9702
9703
9704
9705
9706
|
-
+
|
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 [if {
[dict exists $data -result read]
|
| ︙ | | |
9774
9775
9776
9777
9778
9779
9780
9781
9782
9783
9784
9785
9786
9787
9788
|
9771
9772
9773
9774
9775
9776
9777
9778
9779
9780
9781
9782
9783
9784
9785
|
-
+
|
test {io-75.10 {profile tcl8}} {
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
|
| ︙ | | |
9803
9804
9805
9806
9807
9808
9809
9810
9811
9812
9813
9814
9815
9816
9817
|
9800
9801
9802
9803
9804
9805
9806
9807
9808
9809
9810
9811
9812
9813
9814
|
-
+
|
# 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
|
| ︙ | | |
9868
9869
9870
9871
9872
9873
9874
9875
9876
9877
9878
9879
9880
9881
9882
|
9865
9866
9867
9868
9869
9870
9871
9872
9873
9874
9875
9876
9877
9878
9879
|
-
+
|
test {io-75.12 {profile tcl8}} {
invalid utf-8 encoding read, is not ignored because setting the encoding to
"binary" also sets 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
|
| ︙ | | |
9918
9919
9920
9921
9922
9923
9924
9925
9926
9927
9928
9929
9930
9931
9932
|
9915
9916
9917
9918
9919
9920
9921
9922
9923
9924
9925
9926
9927
9928
9929
|
-
+
|
test io-75.13.nonblocking {
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 {
|
| ︙ | | |
9942
9943
9944
9945
9946
9947
9948
9949
9950
9951
9952
9953
9954
9955
9956
|
9939
9940
9941
9942
9943
9944
9945
9946
9947
9948
9949
9950
9951
9952
9953
|
-
+
|
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 {
|
| ︙ | | |
9976
9977
9978
9979
9980
9981
9982
9983
9984
9985
9986
9987
9988
9989
9990
|
9973
9974
9975
9976
9977
9978
9979
9980
9981
9982
9983
9984
9985
9986
9987
|
-
+
|
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]
|
| ︙ | | |