t/io/eintr_print.t

   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     require "./test.pl";
  10     set_up_inc('../lib');
  11     skip_all_if_miniperl("No XS under miniperl");
  12 }
  13
  14 use strict;
  15 use warnings;
  16
  17 use Config;
  18 use Time::HiRes;
  19 use IO::Handle;
  20
  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; };
  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) );
  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);
  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
  94 1;
  95