1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
|
#!/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";
|
