3 # If a read or write is interrupted by a signal, Perl will call the
4 # signal handler and then attempt to restart the call. If the handler does
5 # something nasty like close the handle or pop layers, make sure that the
6 # read/write handles this gracefully (for some definition of 'graceful':
7 # principally, don't segfault).
26 skip_all('pipe not implemented');
29 unless (exists $Config{'d_alarm'}) {
30 skip_all('alarm not implemented');
34 # XXX for some reason the stdio layer doesn't seem to interrupt
35 # write system call when the alarm triggers. This makes the tests
38 if (exists $ENV{PERLIO} && $ENV{PERLIO} =~ /stdio/ ) {
39 skip_all('stdio not supported for this script');
43 my ($in, $out, $st, $sigst, $buf);
48 # make two handles that will always block
51 undef $in; undef $out; # use fresh handles each time
56 $SIG{PIPE} = 'IGNORE';
61 $SIG{ALRM} = sub { $sigst = close($in) ? "ok" : "nok" };
63 $st = read($in, $buf, 1);
65 is($sigst, 'ok', 'read/close: sig handler close status');
66 ok(!$st, 'read/close: read status');
67 ok(!close($in), 'read/close: close status');
72 $SIG{ALRM} = sub { die };
74 $st = eval { read($in, $buf, 1) };
76 ok(!$st, 'read/die: read status');
77 ok(close($in), 'read/die: close status');
82 $SIG{ALRM} = sub { $sigst = close($out) ? "ok" : "nok" };
83 $buf = "a" x 1_000_000 . "\n"; # bigger than any pipe buffer hopefully
84 select $out; $| = 1; select STDOUT;
86 $st = print $out $buf;
88 is($sigst, 'nok', 'print/close: sig handler close status');
89 ok(!$st, 'print/close: print status');
90 ok(!close($out), 'print/close: close status');
95 $SIG{ALRM} = sub { die };
96 $buf = "a" x 1_000_000 . "\n"; # bigger than any pipe buffer hopefully
97 select $out; $| = 1; select STDOUT;
99 $st = eval { print $out $buf };
101 ok(!$st, 'print/die: print status');
102 # the close will hang since there's data to flush, so use alarm
104 ok(!eval {close($out)}, 'print/die: close status');
109 # Apparently there's nothing in standard Linux that can cause an
110 # EINTR in close(2); but run the code below just in case it does on some
111 # platform, just to see if it segfaults.
113 $SIG{ALRM} = sub { $sigst = close($in) ? "ok" : "nok" };
121 $SIG{ALRM} = sub { die };
126 # vim: ts=4 sts=4 sw=4: