1#!/usr/bin/perl 2$| = 1; 3 4# Note that because fork loses test count we do not use Test::More 5 6use strict; 7 8BEGIN { 9 require Config; 10 my $can_fork = $Config::Config{d_fork} || 11 (($^O eq 'MSWin32' || $^O eq 'NetWare') and 12 $Config::Config{useithreads} and 13 $Config::Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/ 14 ); 15 if ( $can_fork && !(($^O eq 'MSWin32') && $Devel::Cover::VERSION) ) { 16 print "1..8\n"; 17 } else { 18 if ( ($^O eq 'MSWin32') && $Devel::Cover::VERSION ) { 19 print "1..0 # Skip Devel::Cover coverage testing is incompatible with fork under 'MSWin32'\n"; 20 } else { 21 print "1..0 # Skip No fork available\n"; 22 } 23 exit; 24 } 25} 26 27use File::Temp; 28 29# OO interface 30 31my $file = File::Temp->new(); 32 33myok( 1, -f $file->filename, "OO File exists" ); 34 35my $children = 2; 36for my $i (1 .. $children) { 37 my $pid = fork; 38 die "Can't fork: $!" unless defined $pid; 39 if ($pid) { 40 # parent process 41 next; 42 } else { 43 # in a child we can't keep the count properly so we do it manually 44 # make sure that child 1 dies first 45 my $time = ($i-1) * 3; 46 print "# child $i sleeping for $time seconds\n"; 47 sleep($time); 48 my $count = $i + 1; 49 myok( $count, -f $file->filename(), "OO file present in child $i" ); 50 print "# child $i exiting\n"; 51 exit; 52 } 53} 54 55while ($children) { 56 wait; 57 $children--; 58} 59 60 61 62myok( 4, -f $file->filename(), "OO File exists in parent" ); 63 64# non-OO interface 65 66my ($fh, $filename) = File::Temp::tempfile( UNLINK => 1 ); 67 68myok( 5, -f $filename, "non-OO File exists" ); 69 70$children = 2; 71for my $i (1 .. $children) { 72 my $pid = fork; 73 die "Can't fork: $!" unless defined $pid; 74 if ($pid) { 75 # parent process 76 next; 77 } else { 78 my $time = ($i-1) * 3; 79 print "# child $i sleeping for $time seconds\n"; 80 sleep($time); 81 my $count = 5 + $i; 82 myok( $count, -f $filename, "non-OO File present in child $i" ); 83 print "# child $i exiting\n"; 84 exit; 85 } 86} 87 88while ($children) { 89 wait; 90 $children--; 91} 92myok(8, -f $filename, "non-OO File exists in parent" ); 93 94 95# Local ok sub handles explicit number 96sub myok { 97 my ($count, $test, $msg) = @_; 98 99 if ($test) { 100 print "ok $count - $msg\n"; 101 } else { 102 print "not ok $count - $msg\n"; 103 } 104 return $test; 105} 106