1*0Sstevel@tonic-gate#!./perl 2*0Sstevel@tonic-gate 3*0Sstevel@tonic-gateBEGIN { 4*0Sstevel@tonic-gate chdir 't' if -d 't'; 5*0Sstevel@tonic-gate @INC = '../lib'; 6*0Sstevel@tonic-gate require './test.pl'; 7*0Sstevel@tonic-gate} 8*0Sstevel@tonic-gate 9*0Sstevel@tonic-gate# Script to test auto flush on fork/exec/system/qx. The idea is to 10*0Sstevel@tonic-gate# print "Pe" to a file from a parent process and "rl" to the same file 11*0Sstevel@tonic-gate# from a child process. If buffers are flushed appropriately, the 12*0Sstevel@tonic-gate# file should contain "Perl". We'll see... 13*0Sstevel@tonic-gateuse Config; 14*0Sstevel@tonic-gateuse warnings; 15*0Sstevel@tonic-gateuse strict; 16*0Sstevel@tonic-gate 17*0Sstevel@tonic-gate# This attempts to mirror the #ifdef forest found in perl.h so that we 18*0Sstevel@tonic-gate# know when to run these tests. If that forest ever changes, change 19*0Sstevel@tonic-gate# it here too or expect test gratuitous test failures. 20*0Sstevel@tonic-gatemy $useperlio = defined $Config{useperlio} ? $Config{useperlio} eq 'define' ? 1 : 0 : 0; 21*0Sstevel@tonic-gatemy $fflushNULL = defined $Config{fflushNULL} ? $Config{fflushNULL} eq 'define' ? 1 : 0 : 0; 22*0Sstevel@tonic-gatemy $d_sfio = defined $Config{d_sfio} ? $Config{d_sfio} eq 'define' ? 1 : 0 : 0; 23*0Sstevel@tonic-gatemy $fflushall = defined $Config{fflushall} ? $Config{fflushall} eq 'define' ? 1 : 0 : 0; 24*0Sstevel@tonic-gatemy $d_fork = defined $Config{d_fork} ? $Config{d_fork} eq 'define' ? 1 : 0 : 0; 25*0Sstevel@tonic-gate 26*0Sstevel@tonic-gateif ($useperlio || $fflushNULL || $d_sfio) { 27*0Sstevel@tonic-gate print "1..7\n"; 28*0Sstevel@tonic-gate} else { 29*0Sstevel@tonic-gate if ($fflushall) { 30*0Sstevel@tonic-gate print "1..7\n"; 31*0Sstevel@tonic-gate } else { 32*0Sstevel@tonic-gate print "1..0 # Skip: fflush(NULL) or equivalent not available\n"; 33*0Sstevel@tonic-gate exit; 34*0Sstevel@tonic-gate } 35*0Sstevel@tonic-gate} 36*0Sstevel@tonic-gate 37*0Sstevel@tonic-gatemy $runperl = $^X =~ m/\s/ ? qq{"$^X"} : $^X; 38*0Sstevel@tonic-gate$runperl .= qq{ "-I../lib"}; 39*0Sstevel@tonic-gate 40*0Sstevel@tonic-gatemy @delete; 41*0Sstevel@tonic-gate 42*0Sstevel@tonic-gateEND { 43*0Sstevel@tonic-gate for (@delete) { 44*0Sstevel@tonic-gate unlink $_ or warn "unlink $_: $!"; 45*0Sstevel@tonic-gate } 46*0Sstevel@tonic-gate} 47*0Sstevel@tonic-gate 48*0Sstevel@tonic-gatesub file_eq { 49*0Sstevel@tonic-gate my $f = shift; 50*0Sstevel@tonic-gate my $val = shift; 51*0Sstevel@tonic-gate 52*0Sstevel@tonic-gate open IN, $f or die "open $f: $!"; 53*0Sstevel@tonic-gate chomp(my $line = <IN>); 54*0Sstevel@tonic-gate close IN; 55*0Sstevel@tonic-gate 56*0Sstevel@tonic-gate print "# got $line\n"; 57*0Sstevel@tonic-gate print "# expected $val\n"; 58*0Sstevel@tonic-gate return $line eq $val; 59*0Sstevel@tonic-gate} 60*0Sstevel@tonic-gate 61*0Sstevel@tonic-gate# This script will be used as the command to execute from 62*0Sstevel@tonic-gate# child processes 63*0Sstevel@tonic-gateopen PROG, "> ff-prog" or die "open ff-prog: $!"; 64*0Sstevel@tonic-gateprint PROG <<'EOF'; 65*0Sstevel@tonic-gatemy $f = shift; 66*0Sstevel@tonic-gatemy $str = shift; 67*0Sstevel@tonic-gateopen OUT, ">> $f" or die "open $f: $!"; 68*0Sstevel@tonic-gateprint OUT $str; 69*0Sstevel@tonic-gateclose OUT; 70*0Sstevel@tonic-gateEOF 71*0Sstevel@tonic-gate ; 72*0Sstevel@tonic-gateclose PROG or die "close ff-prog: $!";; 73*0Sstevel@tonic-gatepush @delete, "ff-prog"; 74*0Sstevel@tonic-gate 75*0Sstevel@tonic-gate$| = 0; # we want buffered output 76*0Sstevel@tonic-gate 77*0Sstevel@tonic-gate# Test flush on fork/exec 78*0Sstevel@tonic-gateif (!$d_fork) { 79*0Sstevel@tonic-gate print "ok 1 # skipped: no fork\n"; 80*0Sstevel@tonic-gate} else { 81*0Sstevel@tonic-gate my $f = "ff-fork-$$"; 82*0Sstevel@tonic-gate open OUT, "> $f" or die "open $f: $!"; 83*0Sstevel@tonic-gate print OUT "Pe"; 84*0Sstevel@tonic-gate my $pid = fork; 85*0Sstevel@tonic-gate if ($pid) { 86*0Sstevel@tonic-gate # Parent 87*0Sstevel@tonic-gate wait; 88*0Sstevel@tonic-gate close OUT or die "close $f: $!"; 89*0Sstevel@tonic-gate } elsif (defined $pid) { 90*0Sstevel@tonic-gate # Kid 91*0Sstevel@tonic-gate print OUT "r"; 92*0Sstevel@tonic-gate my $command = qq{$runperl "ff-prog" "$f" "l"}; 93*0Sstevel@tonic-gate print "# $command\n"; 94*0Sstevel@tonic-gate exec $command or die $!; 95*0Sstevel@tonic-gate exit; 96*0Sstevel@tonic-gate } else { 97*0Sstevel@tonic-gate # Bang 98*0Sstevel@tonic-gate die "fork: $!"; 99*0Sstevel@tonic-gate } 100*0Sstevel@tonic-gate 101*0Sstevel@tonic-gate print file_eq($f, "Perl") ? "ok 1\n" : "not ok 1\n"; 102*0Sstevel@tonic-gate push @delete, $f; 103*0Sstevel@tonic-gate} 104*0Sstevel@tonic-gate 105*0Sstevel@tonic-gate# Test flush on system/qx/pipe open 106*0Sstevel@tonic-gatemy %subs = ( 107*0Sstevel@tonic-gate "system" => sub { 108*0Sstevel@tonic-gate my $c = shift; 109*0Sstevel@tonic-gate system $c; 110*0Sstevel@tonic-gate }, 111*0Sstevel@tonic-gate "qx" => sub { 112*0Sstevel@tonic-gate my $c = shift; 113*0Sstevel@tonic-gate qx{$c}; 114*0Sstevel@tonic-gate }, 115*0Sstevel@tonic-gate "popen" => sub { 116*0Sstevel@tonic-gate my $c = shift; 117*0Sstevel@tonic-gate open PIPE, "$c|" or die "$c: $!"; 118*0Sstevel@tonic-gate close PIPE; 119*0Sstevel@tonic-gate }, 120*0Sstevel@tonic-gate ); 121*0Sstevel@tonic-gatemy $t = 2; 122*0Sstevel@tonic-gatefor (qw(system qx popen)) { 123*0Sstevel@tonic-gate my $code = $subs{$_}; 124*0Sstevel@tonic-gate my $f = "ff-$_-$$"; 125*0Sstevel@tonic-gate my $command = qq{$runperl "ff-prog" "$f" "rl"}; 126*0Sstevel@tonic-gate open OUT, "> $f" or die "open $f: $!"; 127*0Sstevel@tonic-gate print OUT "Pe"; 128*0Sstevel@tonic-gate close OUT or die "close $f: $!";; 129*0Sstevel@tonic-gate print "# $command\n"; 130*0Sstevel@tonic-gate $code->($command); 131*0Sstevel@tonic-gate print file_eq($f, "Perl") ? "ok $t\n" : "not ok $t\n"; 132*0Sstevel@tonic-gate push @delete, $f; 133*0Sstevel@tonic-gate ++$t; 134*0Sstevel@tonic-gate} 135*0Sstevel@tonic-gate 136*0Sstevel@tonic-gatemy $cmd = _create_runperl( 137*0Sstevel@tonic-gate switches => ['-l'], 138*0Sstevel@tonic-gate prog => 139*0Sstevel@tonic-gate sprintf('print qq[ok $_] for (%d..%d)', $t, $t+2)); 140*0Sstevel@tonic-gateprint "# cmd = '$cmd'\n"; 141*0Sstevel@tonic-gateopen my $CMD, "$cmd |" or die "Can't open pipe to '$cmd': $!"; 142*0Sstevel@tonic-gatewhile (<$CMD>) { 143*0Sstevel@tonic-gate system("$runperl -e 0"); 144*0Sstevel@tonic-gate print; 145*0Sstevel@tonic-gate} 146*0Sstevel@tonic-gateclose $CMD; 147*0Sstevel@tonic-gate$t += 3; 148