X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fio%2Ffflush.t;h=19143c6304cded1140d50c9412ade2bcd2ba525b;hb=213f370f28504f3af87af602895b0afe68c0106a;hp=8c6bd080a1f68f6691d6705f25924333cb68a427;hpb=a43cb6b7285a7b606eaff5be9a8b1373e51fbfb7;p=p5sagit%2Fp5-mst-13.2.git diff --git a/t/io/fflush.t b/t/io/fflush.t index 8c6bd08..19143c6 100644 --- a/t/io/fflush.t +++ b/t/io/fflush.t @@ -3,6 +3,7 @@ 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 @@ -16,18 +17,26 @@ 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. -if ($Config{useperlio} || $Config{fflushNULL} || $Config{d_sfio}) { - print "1..4\n"; +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 $d_sfio = defined $Config{d_sfio} ? $Config{d_sfio} 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; + +if ($useperlio || $fflushNULL || $d_sfio) { + print "1..7\n"; } else { - if ($Config{fflushall}) { - print "1..4\n"; + if ($fflushall) { + print "1..7\n"; } else { print "1..0 # Skip: fflush(NULL) or equivalent not available\n"; exit; } } -my $runperl = qq{$^X "-I../lib"}; +my $runperl = $^X =~ m/\s/ ? qq{"$^X"} : $^X; +$runperl .= qq{ "-I../lib"}; + my @delete; END { @@ -60,13 +69,13 @@ print OUT $str; close OUT; EOF ; -close PROG; +close PROG or die "close ff-prog: $!";; push @delete, "ff-prog"; $| = 0; # we want buffered output # Test flush on fork/exec -if ($Config{d_fork} ne "define") { +if (!$d_fork) { print "ok 1 # skipped: no fork\n"; } else { my $f = "ff-fork-$$"; @@ -116,10 +125,23 @@ for (qw(system qx popen)) { my $command = qq{$runperl "ff-prog" "$f" "rl"}; open OUT, "> $f" or die "open $f: $!"; print OUT "Pe"; + close OUT or die "close $f: $!";; print "# $command\n"; $code->($command); - close OUT; print file_eq($f, "Perl") ? "ok $t\n" : "not ok $t\n"; push @delete, $f; ++$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;