#!/usr/bin/perl ## Submitted by Borislav Deianov <borislav@users.sourceforge.net> ## 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', '<STDIN>, print "\n" x ' . $_[0] . '; while(<STDIN>){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 ), '<pty<', \$in, '>', \$out ); print "done\n";
Generated by dwww version 1.15 on Sun Jun 16 03:38:28 CEST 2024.