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 7BEGIN { 8 chdir 't' if -d 't'; 9 require "./test.pl"; 10 set_up_inc('../lib'); 11 skip_all_if_miniperl("No XS under miniperl"); 12} 13 14use strict; 15use warnings; 16 17use Config; 18use Time::HiRes; 19use IO::Handle; 20 21skip_all("only for dev versions for now") if ((int($]*1000) & 1) == 0); 22skip_all("does not match platform whitelist") 23 unless ($^O =~ /^(linux|.*bsd|darwin|solaris)$/); 24skip_all("ualarm() not implemented on this platform") 25 unless Time::HiRes::d_ualarm(); 26skip_all("usleep() not implemented on this platform") 27 unless Time::HiRes::d_usleep(); 28skip_all("pipe not implemented on this platform") 29 unless eval { pipe my $in, my $out; 1; }; 30skip_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 ) 34my ($osmajmin) = $Config{osvers} =~ /^(\d+\.\d+)/; 35 36skip_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) ); 40 41my $sample = 'abxhrtf6'; 42my $full_sample = 'abxhrtf6' x (8192-7); 43my $sample_l = length $full_sample; 44 45my $ppid = $$; 46 47pipe my $in, my $out; 48 49my $small_delay = 10_000; 50my $big_delay = $small_delay * 3; 51my $fail_delay = 20_000_000; 52 53if (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); 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); 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 } 90 Time::HiRes::usleep(500_000); 91 exit(0); 92} 93 941; 95 96