blob: 1a0d84d39ce2e26fde07dea562feeda7af61ba74 (
plain)
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
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
|
#!./perl
# print should not return EINTR
# fails under 5.14.x see https://rt.perl.org/rt3/Ticket/Display.html?id=119097
# also fails under 5.8.x
BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
require './test.pl';
skip_all_if_miniperl("No XS under miniperl");
}
use strict;
use warnings;
use Config;
use Time::HiRes;
use IO::Handle;
skip_all("only for dev versions for now") if ((int($]*1000) & 1) == 0);
skip_all("does not match platform whitelist")
unless ($^O =~ /^(linux|.*bsd|darwin|solaris)$/);
skip_all("ualarm() not implemented on this platform")
unless Time::HiRes::d_ualarm();
skip_all("usleep() not implemented on this platform")
unless Time::HiRes::d_usleep();
skip_all("pipe not implemented on this platform")
unless eval { pipe my $in, my $out; 1; };
skip_all("not supposed to work with stdio")
if (defined $ENV{PERLIO} && $ENV{PERLIO} =~ /stdio/ );
# copy OS blacklist from eintr.t ( related to perl #85842 and #84688 )
my ($osmajmin) = $Config{osvers} =~ /^(\d+\.\d+)/;
skip_all('various portability issues')
if ( $^O =~ /freebsd/ || $^O eq 'midnightbsd' ||
($^O eq 'solaris' && $Config{osvers} eq '2.8') ||
($^O eq 'darwin' && $osmajmin < 9) );
my $sample = 'abxhrtf6';
my $full_sample = 'abxhrtf6' x (8192-7);
my $sample_l = length $full_sample;
my $ppid = $$;
pipe my $in, my $out;
my $small_delay = 10_000;
my $big_delay = $small_delay * 3;
my $fail_delay = 20_000_000;
if (my $pid = fork()) {
plan(tests => 20);
local $SIG{ALRM} = sub { print STDERR "FAILED $$\n"; exit(1) };
my $child_exited = 0;
$in->autoflush(1);
$in->blocking(1);
Time::HiRes::usleep $big_delay;
# in case test fail it should not hang, however this is not always helping
Time::HiRes::ualarm($fail_delay);
for (1..10) {
my $n = read($in, my $x, $sample_l);
die "EOF" unless $n;
# should return right amount of data
is($n, $sample_l);
# should return right data
# don't use "is()" as output in case of fail is big and useless
ok($x eq $full_sample);
}
Time::HiRes::ualarm(0);
while(wait() != -1 ){};
} else {
local $SIG{ALRM} = sub { print "# ALRM $$\n" };
$out->autoflush(1);
$out->blocking(1);
for (1..10) { # on some iteration print() will block
Time::HiRes::ualarm($small_delay); # and when it block we'll get SIGALRM
# it should unblock and continue after $big_delay
die "print failed [ $! ]" unless print($out $full_sample);
Time::HiRes::ualarm(0);
}
Time::HiRes::usleep(500_000);
exit(0);
}
1;
|
