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

BEGIN {
    chdir 't' if -d 't';
    @INC = '../lib';
    require './test.pl';
}

# Script to test auto flush on fork/exec/system/qx.  The idea is to
# print "Pe" to a file from a parent process and "rl" to the same file
# from a child process.  If buffers are flushed appropriately, the
# file should contain "Perl".  We'll see...
use Config;
use warnings;
use strict;

# This attempts to mirror the #ifdef forest found in perl.h so that we
# know when to run these tests.  If that forest ever changes, change
# it here too or expect test gratuitous test failures.
my $useperlio = defined $Config{useperlio} ? $Config{useperlio} eq 'define' ? 1 : 0 : 0;
my $fflushNULL = defined $Config{fflushNULL} ? $Config{fflushNULL} eq 'define' ? 1 : 0 : 0;
my $fflushall = defined $Config{fflushall} ? $Config{fflushall} eq 'define' ? 1 : 0 : 0;
my $d_fork = defined $Config{d_fork} ? $Config{d_fork} eq 'define' ? 1 : 0 : 0;

skip_all('fflush(NULL) or equivalent not available')
    unless $useperlio || $fflushNULL || $fflushall;

plan(tests => 7);

my $runperl = $^X =~ m/\s/ ? qq{"$^X"} : $^X;
$runperl .= qq{ "-I../lib"};

sub file_eq {
    my $f   = shift;
    my $val = shift;

open IN, $f or die "open $f: $!";
    chomp(my $line = <IN>);
    close IN;

print "# got $line\n";
    print "# expected $val\n";
    return $line eq $val;
}

# This script will be used as the command to execute from
# child processes
my $ffprog = tempfile();
open PROG, "> $ffprog" or die "open $ffprog: $!";
print PROG <<'EOF';
my $f = shift;
my $str = shift;
open OUT, ">> $f" or die "open $f: $!";
print OUT $str;
close OUT;
EOF
    ;
close PROG or die "close $ffprog: $!";;

$| = 0; # we want buffered output

# Test flush on fork/exec
if (!$d_fork) {
    print "ok 1 # skipped: no fork\n";
} else {
    my $f = tempfile();
    open OUT, "> $f" or die "open $f: $!";
    print OUT "Pe";
    my $pid = fork;
    if ($pid) {
	# Parent
	wait;
	close OUT or die "close $f: $!";
    } elsif (defined $pid) {
	# Kid
	print OUT "r";
	my $command = qq{$runperl "$ffprog" "$f" "l"};
	print "# $command\n";
	exec $command or die $!;
	exit;
    } else {
	# Bang
	die "fork: $!";
    }

print file_eq($f, "Perl") ? "ok 1\n" : "not ok 1\n";
}

# Test flush on system/qx/pipe open
my %subs = (
            "system" => sub {
                my $c = shift;
                system $c;
            },
            "qx"     => sub {
                my $c = shift;
                qx{$c};
            },
            "popen"  => sub {
                my $c = shift;
                open PIPE, "$c|" or die "$c: $!";
                close PIPE;
            },
            );
my $t = 2;
for (qw(system qx popen)) {
    my $code    = $subs{$_};
    my $f       = tempfile();
    my $command = qq{$runperl $ffprog "$f" "rl"};
    open OUT, "> $f" or die "open $f: $!";
    print OUT "Pe";
    close OUT or die "close $f: $!";;
    print "# $command\n";
    $code->($command);
    print file_eq($f, "Perl") ? "ok $t\n" : "not ok $t\n";
    ++$t;
}

my $cmd = _create_runperl(
			  switches => ['-l'],
			  prog =>
			  sprintf('print qq[ok $_] for (%d..%d)', $t, $t+2));
print "# cmd = '$cmd'\n";
open my $CMD, "$cmd |" or die "Can't open pipe to '$cmd': $!";
while (<$CMD>) {
    system("$runperl -e 0");
    print;
}
close $CMD;
$t += 3;
curr_test($t);