#!/usr/bin/perl ## Submitted by Borislav Deianov ## This stresses the blocking write to see if it blocks. use Fcntl; use IO::Pty; use IPC::Run qw(run); sub makecmd { return ['perl', '-e', ', print "\n" x '.$_[0].'; while(){last if /end/}']; } pipe R, W; fcntl(W, F_SETFL, O_NONBLOCK); while (syswrite(W, "\n", 1)) { $pipebuf++ }; print "pipe buffer size is $pipebuf\n"; $in = "\n" x ($pipebuf * 3) . "end\n"; print "reading from scalar via pipe... "; run(makecmd($pipebuf * 3), '<', \$in, '>', \$out); print "done\n"; print "reading from code via pipe... "; run(makecmd($pipebuf * 3), '<', sub { $t = $in; undef $in; $t}, '>', \$out); print "done\n"; $pty = IO::Pty->new(); $pty->blocking(0); $slave = $pty->slave(); while ($pty->syswrite("\n", 1)) { $ptybuf++ }; print "pty buffer size is $ptybuf\n"; $in = "\n" x ($ptybuf * 3) . "end\n"; print "reading via pty... "; run(makecmd($ptybuf * 3), '', \$out); print "done\n";