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