9 # Script to test auto flush on fork/exec/system/qx. The idea is to
10 # print "Pe" to a file from a parent process and "rl" to the same file
11 # from a child process. If buffers are flushed appropriately, the
12 # file should contain "Perl". We'll see...
17 # This attempts to mirror the #ifdef forest found in perl.h so that we
18 # know when to run these tests. If that forest ever changes, change
19 # it here too or expect test gratuitous test failures.
20 my $useperlio = defined $Config{useperlio} ? $Config{useperlio} eq 'define' ? 1 : 0 : 0;
21 my $fflushNULL = defined $Config{fflushNULL} ? $Config{fflushNULL} eq 'define' ? 1 : 0 : 0;
22 my $d_sfio = defined $Config{d_sfio} ? $Config{d_sfio} eq 'define' ? 1 : 0 : 0;
23 my $fflushall = defined $Config{fflushall} ? $Config{fflushall} eq 'define' ? 1 : 0 : 0;
24 my $d_fork = defined $Config{d_fork} ? $Config{d_fork} eq 'define' ? 1 : 0 : 0;
26 if ($useperlio || $fflushNULL || $d_sfio) {
32 print "1..0 # Skip: fflush(NULL) or equivalent not available\n";
37 my $runperl = $^X =~ m/\s/ ? qq{"$^X"} : $^X;
38 $runperl .= qq{ "-I../lib"};
44 unlink $_ or warn "unlink $_: $!";
52 open IN, $f or die "open $f: $!";
53 chomp(my $line = <IN>);
56 print "# got $line\n";
57 print "# expected $val\n";
61 # This script will be used as the command to execute from
63 open PROG, "> ff-prog" or die "open ff-prog: $!";
67 open OUT, ">> $f" or die "open $f: $!";
72 close PROG or die "close ff-prog: $!";;
73 push @delete, "ff-prog";
75 $| = 0; # we want buffered output
77 # Test flush on fork/exec
79 print "ok 1 # skipped: no fork\n";
82 open OUT, "> $f" or die "open $f: $!";
88 close OUT or die "close $f: $!";
89 } elsif (defined $pid) {
92 my $command = qq{$runperl "ff-prog" "$f" "l"};
94 exec $command or die $!;
101 print file_eq($f, "Perl") ? "ok 1\n" : "not ok 1\n";
105 # Test flush on system/qx/pipe open
117 open PIPE, "$c|" or die "$c: $!";
122 for (qw(system qx popen)) {
123 my $code = $subs{$_};
125 my $command = qq{$runperl "ff-prog" "$f" "rl"};
126 open OUT, "> $f" or die "open $f: $!";
128 close OUT or die "close $f: $!";;
129 print "# $command\n";
131 print file_eq($f, "Perl") ? "ok $t\n" : "not ok $t\n";
136 my $cmd = _create_runperl(
139 sprintf('print qq[ok $_] for (%d..%d)', $t, $t+2));
140 print "# cmd = '$cmd'\n";
141 open my $CMD, "$cmd |" or die "Can't open pipe to '$cmd': $!";
143 system("$runperl -e 0");