Tcl Source Code

Artifact [751e85bea7]
Login

Artifact 751e85bea79190e9c85e42ec2839a0af5aa47661:

Attachment "fcasync.tcl" to ticket [1932639fff] added by ferrieux 2008-04-03 16:49:39.
#! /bin/sh
#\
exec tclsh $0

set f [open foo w]
puts $f ashgdfashdgfasdhgfasdhgf
close $f

set f [open foo r]
fconfigure $f -translation binary

set g [open bar w]
fconfigure $g -translation binary -buffering none

proc cmd args {puts stderr CMD:$args;error yo}

proc bgerror args {puts stderr "SUCCESS(bgerror): $args";exit 0}

puts stderr "Initial bar size = [file size bar]"
fcopy $f $g -size 2 -command cmd

set sbs [file size bar]
if {$sbs>0} {set status FAILURE} else {set status SUCCESS}
puts stderr "$status (sync suppression): bar size = $sbs"


after 1000 {puts stderr "FAILURE(bgerror): timeout";exit 1}
vwait forever