Gecko [ www.blackthorn-inc.com ]

Name	Size	Permission	Date
argv.t	3.92 KB	-r--r--r--	2014-12-27 11:49
binmode.t	1.02 KB	-r--r--r--	2014-12-27 11:49
bom.t	329 B	-r--r--r--	2014-12-27 11:49
closepid.t	1.26 KB	-r--r--r--	2014-12-27 11:49
crlf.t	2.45 KB	-r--r--r--	2014-12-27 11:49
crlf_through.t	152 B	-r--r--r--	2014-12-27 11:49
data.t	1.5 KB	-r--r--r--	2014-12-27 11:49
defout.t	1.09 KB	-r--r--r--	2014-12-27 11:49
dup.t	3.09 KB	-r--r--r--	2014-12-27 11:49
eintr.t	3.65 KB	-r--r--r--	2015-01-12 20:14
eintr_print.t	2.48 KB	-r--r--r--	2014-12-27 11:49
errno.t	1.12 KB	-r--r--r--	2014-12-27 11:49
errnosig.t	746 B	-r--r--r--	2014-12-27 11:49
fflush.t	3.25 KB	-r--r--r--	2014-12-27 11:49
fs.t	12.97 KB	-r--r--r--	2014-12-27 11:49
inplace.t	1.83 KB	-r--r--r--	2014-12-27 11:49
iofile.t	644 B	-r--r--r--	2014-12-27 11:49
iprefix.t	707 B	-r--r--r--	2014-12-27 11:49
layers.t	6.37 KB	-r--r--r--	2014-12-27 11:49
nargv.t	1.16 KB	-r--r--r--	2014-12-27 11:49
open.t	14.56 KB	-r--r--r--	2014-12-27 11:49
openpid.t	2.39 KB	-r--r--r--	2014-12-27 11:49
perlio.t	5.73 KB	-r--r--r--	2014-12-27 11:49
perlio_fail.t	1.06 KB	-r--r--r--	2014-12-27 11:49
perlio_leaks.t	675 B	-r--r--r--	2014-12-27 11:49
perlio_open.t	756 B	-r--r--r--	2014-12-27 11:49
pipe.t	5.9 KB	-r--r--r--	2014-12-27 11:49
print.t	1.41 KB	-r--r--r--	2014-12-27 11:49
pvbm.t	2.39 KB	-r--r--r--	2014-12-27 11:49
read.t	523 B	-r--r--r--	2014-12-27 11:49
say.t	1.05 KB	-r--r--r--	2014-12-27 11:49
sem.t	1.78 KB	-r--r--r--	2014-12-27 11:49
shm.t	2.56 KB	-r--r--r--	2014-12-27 11:49
socket.t	3.51 KB	-r--r--r--	2014-12-27 11:49
tell.t	4.94 KB	-r--r--r--	2014-12-27 11:49
through.t	4.52 KB	-r--r--r--	2014-12-27 11:49
utf8.t	9.28 KB	-r--r--r--	2014-12-27 11:49

Rename

#!./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);
}