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