Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | Add io-28.6 an io-28.7 to test closing a channel within a channel event handler. |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | core-8-branch |
| Files: | files | file ages | folders |
| SHA3-256: |
f44cac056f9814923aab1dc82fd3a8e5 |
| User & Date: | pooryorick 2021-04-26 22:53:42.789 |
Context
|
2021-04-26
| ||
| 23:02 | Fix typo in tcltests.tcl. check-in: eee6ea9713 user: pooryorick tags: core-8-branch | |
| 22:53 | Add io-28.6 an io-28.7 to test closing a channel within a channel event handler. check-in: f44cac056f user: pooryorick tags: core-8-branch | |
| 22:52 | merge pyk-tcltests check-in: e9c99bce1d user: pooryorick tags: core-8-branch | |
Changes
Changes to tests/io.test.
| ︙ | ︙ | |||
2342 2343 2344 2345 2346 2347 2348 |
}
if {$counter == 1000} {
set result probably_broken
} else {
set result ok
}
} ok
| | | | 2342 2343 2344 2345 2346 2347 2348 2349 2350 2351 2352 2353 2354 2355 2356 2357 2358 |
}
if {$counter == 1000} {
set result probably_broken
} else {
set result ok
}
} ok
test io-28.4 Tcl_Close testchannel {
file delete $path(test1)
set l {}
lappend l [lsort [testchannel open]]
set f [open $path(test1) w]
lappend l [lsort [testchannel open]]
close $f
lappend l [lsort [testchannel open]]
set x [list $consoleFileNames \
[lsort [list {*}$consoleFileNames $f]] \
|
| ︙ | ︙ | |||
2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 |
}
close $f
set f [open "|[list [interpreter] $path(script)]" r]
set l [gets $f]
close $f
lsort $l
} {file1 file2}
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]
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 2368 2369 2370 2371 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 2400 2401 2402 2403 2404 2405 2406 2407 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 2442 2443 2444 2445 2446 2447 2448 2449 |
}
close $f
set f [open "|[list [interpreter] $path(script)]" r]
set l [gets $f]
close $f
lsort $l
} {file1 file2}
test io-28.6 {
close channel in write event handler
Should not produce a segmentation fault in a Tcl built with
--enable-symbols and -DPURIFY
} debugpurify {
variable done
variable res
after 0 [list coroutine c1 apply [list {} {
variable done
set chan [chan create w {apply {args {
list initialize finalize watch write configure blocking
}}}]
chan configure $chan -blocking 0
while 1 {
chan event $chan writable [list [info coroutine]]
yield
close $chan
set done 1
return
}
} [namespace current]]]
vwait [namespace current]::done
return success
} success
test io-28.7 {
close channel in read event handler
Should not produce a segmentation fault in a Tcl built with
--enable-symbols and -DPURIFY
} debugpurify {
variable done
variable res
after 0 [list coroutine c1 apply [list {} {
variable done
set chan [chan create r {apply {{cmd chan args} {
switch $cmd {
blocking - finalize {
}
watch {
chan postevent $chan read
}
initialize {
list initialize finalize watch read write configure blocking
}
default {
error [list {unexpected command} $cmd]
}
}
}}}]
chan configure $chan -blocking 0
while 1 {
chan event $chan readable [list [info coroutine]]
yield
close $chan
set done 1
return
}
} [namespace current]]]
vwait [namespace current]::done
return success
} success
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]
|
| ︙ | ︙ | |||
5306 5307 5308 5309 5310 5311 5312 |
test io-39.1 {Tcl_GetChannelOption} {
file delete $path(test1)
set f1 [open $path(test1) w]
set x [fconfigure $f1 -blocking]
close $f1
set x
} 1
| < < < | 5374 5375 5376 5377 5378 5379 5380 5381 5382 5383 5384 5385 5386 5387 |
test io-39.1 {Tcl_GetChannelOption} {
file delete $path(test1)
set f1 [open $path(test1) w]
set x [fconfigure $f1 -blocking]
close $f1
set x
} 1
test io-39.2 {Tcl_GetChannelOption} {
file delete $path(test1)
set f1 [open $path(test1) w]
set x [fconfigure $f1 -buffering]
close $f1
set x
} full
|
| ︙ | ︙ |