8 # Script to test auto flush on fork/exec/system/qx. The idea is to
9 # print "Pe" to a file from a parent process and "rl" to the same file
10 # from a child process. If buffers are flushed appropriately, the
11 # file should contain "Perl". We'll see...
16 # This attempts to mirror the #ifdef forest found in perl.h so that we
17 # know when to run these tests. If that forest ever changes, change
18 # it here too or expect test gratuitous test failures.
19 if ($Config{useperlio} || $Config{fflushNULL} || $Config{d_sfio}) {
22 if ($Config{fflushall}) {
25 print "1..0 # Skip: fflush(NULL) or equivalent not available\n";
30 my $runperl = qq{$^X "-I../lib"};
35 unlink $_ or warn "unlink $_: $!";
43 open IN, $f or die "open $f: $!";
44 chomp(my $line = <IN>);
47 print "# got $line\n";
48 print "# expected $val\n";
52 # This script will be used as the command to execute from
54 open PROG, "> ff-prog" or die "open ff-prog: $!";
58 open OUT, ">> $f" or die "open $f: $!";
64 push @delete, "ff-prog";
66 $| = 0; # we want buffered output
68 # Test flush on fork/exec
69 if ($Config{d_fork} ne "define") {
70 print "ok 1 # skipped: no fork\n";
73 open OUT, "> $f" or die "open $f: $!";
79 close OUT or die "close $f: $!";
80 } elsif (defined $pid) {
83 my $command = qq{$runperl "ff-prog" "$f" "l"};
85 exec $command or die $!;
92 print file_eq($f, "Perl") ? "ok 1\n" : "not ok 1\n";
96 # Test flush on system/qx/pipe open
108 open PIPE, "$c|" or die "$c: $!";
113 for (qw(system qx popen)) {
114 my $code = $subs{$_};
116 my $command = qq{$runperl "ff-prog" "$f" "rl"};
117 open OUT, "> $f" or die "open $f: $!";
119 print "# $command\n";
122 print file_eq($f, "Perl") ? "ok $t\n" : "not ok $t\n";