1# -*- perl -*- 2# 3 4require 5.004; 5use strict; 6use IO::Socket (); 7use Config (); 8use Net::Daemon::Test (); 9use Fcntl (); 10use Config (); 11 12 13my $debug = 0; 14my $dh; 15if ($debug) { 16 $dh = Symbol::gensym(); 17 open($dh, ">", "forkm.log") or die "Failed to open forkm.log: $!"; 18} 19 20sub log($) { 21 my $msg = shift; 22 print $dh "$$: $msg\n" if $dh; 23} 24 25&log("Start"); 26my $ok; 27eval { 28 if ($^O ne "MSWin32") { 29 my $pid = fork(); 30 if (defined($pid)) { 31 if (!$pid) { exit 0; } # Child 32 } 33 wait; 34 $ok = 1; 35 } 36}; 37if (!$ok) { 38 &log("!ok"); 39 print "1..0\n"; 40 exit; 41} 42 43 44$| = 1; 45$^W = 1; 46 47 48my($handle, $port); 49if (@ARGV) { 50 $port = shift @ARGV; 51} else { 52 ($handle, $port) = Net::Daemon::Test->Child 53 (10, $^X, '-Iblib/lib', '-Iblib/arch', 't/server', 54 '--mode=fork', 'logfile=stderr', 'debug'); 55} 56 57 58sub IsNum { 59 my $str = shift; 60 (defined($str) && $str =~ /(\d+)/) ? $1 : undef; 61} 62 63 64sub ReadWrite { 65 my $fh = shift; my $i = shift; my $j = shift; 66 &log("ReadWrite: -> fh=$fh, i=$i, j=$j"); 67 if (!$fh->print("$j\n") || !$fh->flush()) { 68 die "Child $i: Error while writing $j: " . $fh->error() . " ($!)"; 69 } 70 my $line = $fh->getline(); 71 &log("ReadWrite: line=$line"); 72 die "Child $i: Error while reading: " . $fh->error() . " ($!)" 73 unless defined($line); 74 my $num; 75 die "Child $i: Cannot parse result: $line" 76 unless defined($num = IsNum($line)); 77 die "Child $i: Expected " . ($j*2) . ", got $num" 78 unless $j*2 == $num; 79 &log("ReadWrite: <-"); 80} 81 82 83sub MyChild { 84 my $i = shift; 85 86 &log("MyChild: -> $i"); 87 88 eval { 89 my $fh = IO::Socket::INET->new('PeerAddr' => '127.0.0.1', 90 'PeerPort' => $port); 91 if (!$fh) { 92 &log("MyChild: Cannot connect: $!"); 93 die "Cannot connect: $!"; 94 } 95 for (my $j = 0; $j < 1000; $j++) { 96 ReadWrite($fh, $i, $j); 97 } 98 }; 99 if ($@) { 100 print STDERR "Client: Error $@\n"; 101 &log("MyChild: Client: Error $@"); 102 return 0; 103 } 104 &log("MyChild: <-"); 105 return 1; 106} 107 108 109sub ShowResults { 110 &log("ShowResults: ->"); 111 my @results; 112 for (my $i = 1; $i <= 10; $i++) { 113 $results[$i-1] = "not ok $i\n"; 114 } 115 if (open(LOG, "<log")) { 116 while (defined(my $line = <LOG>)) { 117 if ($line =~ /(\d+)/) { 118 $results[$1-1] = $line; 119 } 120 } 121 } 122 for (my $i = 1; $i <= 10; $i++) { 123 print $results[$i-1]; 124 } 125 &log("ShowResults: <-"); 126 exit 0; 127} 128 129my %childs; 130sub CatchChild { 131 &log("CatchChild: ->"); 132 for(;;) { 133 my $pid = wait; 134 if ($pid > 0) { 135 &log("CatchChild: $pid"); 136 if (exists $childs{$pid}) { 137 delete $childs{$pid}; 138 if (keys(%childs) == 0) { 139 # We ae done when the last of our ten childs are gone. 140 ShowResults(); 141 last; 142 } 143 } 144 } 145 } 146 $SIG{'CHLD'} = \&CatchChild; 147 &log("CatchChild: <-"); 148} 149$SIG{'CHLD'} = \&CatchChild; 150 151# Spawn 10 childs, each of them running a series of test 152unlink "log"; 153&log("Spawning childs"); 154for (my $i = 0; $i < 10; $i++) { 155 if (defined(my $pid = fork())) { 156 if ($pid) { 157 # This is the parent 158 $childs{$pid} = $i; 159 } else { 160 &log("Child starting"); 161 # This is the child 162 undef $handle; 163 %childs = (); 164 my $result = MyChild($i); 165 my $fh = Symbol::gensym(); 166 if (!open($fh, ">>log") || !flock($fh, 2) || 167 !seek($fh, 0, 2) || 168 !(print $fh (($result ? "ok " : "not ok "), ($i+1), "\n")) || 169 !close($fh)) { 170 print STDERR "Error while writing log file: $!\n"; 171 exit 1; 172 } 173 exit 0; 174 } 175 } else { 176 print STDERR "Failed to create new child: $!\n"; 177 exit 1; 178 } 179} 180 181my $secs = 120; 182while ($secs > 0) { 183 $secs -= sleep $secs; 184} 185 186END { 187 &log("END: -> handle=" . (defined($handle) ? $handle : "undef")); 188 if ($handle) { 189 $handle->Terminate(); 190 undef $handle; 191 } 192 while (my($var, $val) = each %childs) { 193 kill 'TERM', $var; 194 } 195 %childs = (); 196 unlink "ndtest.prt"; 197 &log("END: <-"); 198 exit 0; 199} 200