7574
7575
7576
7577
7578
7579
7580
7581
7582
7583
7584
7585
7586
7587
7588
7589
7590
7591
7592
7593
7594
7595
7596
7597
7598
7599
7600
7601
7602
7603
7604
7605
7606
7607
|
set listen [socket -server [namespace code FcopyTestAccept] -myaddr 127.0.0.1 0]
set in [open $thisScript] ;# 126 K
set out [socket 127.0.0.1 [lindex [fconfigure $listen -sockname] 2]]
catch {unset fcopyTestDone}
close $listen ;# This means the socket open never really succeeds
fcopy $in $out -command [namespace code FcopyTestDone]
variable fcopyTestDone
if ![info exists fcopyTestDone] {
vwait [namespace which -variable fcopyTestDone] ;# The error occurs here in the b.g.
}
close $in
close $out
set fcopyTestDone ;# 1 for error condition
} 1
test io-53.6 {CopyData: error during fcopy} {stdio fcopy} {
variable fcopyTestDone
file delete $path(pipe)
file delete $path(test1)
catch {unset fcopyTestDone}
set f1 [open $path(pipe) w]
puts $f1 "exit 1"
close $f1
set in [open "|[list [interpreter] $path(pipe)]" r+]
set out [open $path(test1) w]
fcopy $in $out -command [namespace code FcopyTestDone]
variable fcopyTestDone
if ![info exists fcopyTestDone] {
vwait [namespace which -variable fcopyTestDone]
}
catch {close $in}
close $out
set fcopyTestDone ;# 0 for plain end of file
} {0}
proc doFcopy {in out {bytes 0} {error {}}} {
|
|
|
|
7574
7575
7576
7577
7578
7579
7580
7581
7582
7583
7584
7585
7586
7587
7588
7589
7590
7591
7592
7593
7594
7595
7596
7597
7598
7599
7600
7601
7602
7603
7604
7605
7606
7607
|
set listen [socket -server [namespace code FcopyTestAccept] -myaddr 127.0.0.1 0]
set in [open $thisScript] ;# 126 K
set out [socket 127.0.0.1 [lindex [fconfigure $listen -sockname] 2]]
catch {unset fcopyTestDone}
close $listen ;# This means the socket open never really succeeds
fcopy $in $out -command [namespace code FcopyTestDone]
variable fcopyTestDone
if {![info exists fcopyTestDone]} {
vwait [namespace which -variable fcopyTestDone] ;# The error occurs here in the b.g.
}
close $in
close $out
set fcopyTestDone ;# 1 for error condition
} 1
test io-53.6 {CopyData: error during fcopy} {stdio fcopy} {
variable fcopyTestDone
file delete $path(pipe)
file delete $path(test1)
catch {unset fcopyTestDone}
set f1 [open $path(pipe) w]
puts $f1 "exit 1"
close $f1
set in [open "|[list [interpreter] $path(pipe)]" r+]
set out [open $path(test1) w]
fcopy $in $out -command [namespace code FcopyTestDone]
variable fcopyTestDone
if {![info exists fcopyTestDone]} {
vwait [namespace which -variable fcopyTestDone]
}
catch {close $in}
close $out
set fcopyTestDone ;# 0 for plain end of file
} {0}
proc doFcopy {in out {bytes 0} {error {}}} {
|
7640
7641
7642
7643
7644
7645
7646
7647
7648
7649
7650
7651
7652
7653
7654
|
exit 0
}
close $f1
set in [open "|[list [interpreter] $path(pipe) &]" r+]
set out [open $path(test1) w]
doFcopy $in $out
variable fcopyTestDone
if ![info exists fcopyTestDone] {
vwait [namespace which -variable fcopyTestDone]
}
catch {close $in}
close $out
# -1=error 0=script error N=number of bytes
expr ($fcopyTestDone == 0) ? $fcopyTestCount : -1
} {3450}
|
|
|
7640
7641
7642
7643
7644
7645
7646
7647
7648
7649
7650
7651
7652
7653
7654
|
exit 0
}
close $f1
set in [open "|[list [interpreter] $path(pipe) &]" r+]
set out [open $path(test1) w]
doFcopy $in $out
variable fcopyTestDone
if {![info exists fcopyTestDone]} {
vwait [namespace which -variable fcopyTestDone]
}
catch {close $in}
close $out
# -1=error 0=script error N=number of bytes
expr ($fcopyTestDone == 0) ? $fcopyTestCount : -1
} {3450}
|