1# -*- perl -*- 2# 3# $Id: threadm.t,v 1.2 1999/08/12 14:28:59 joe Exp $ 4# 5 6require 5.004; 7use strict; 8 9use IO::Socket (); 10use Config (); 11use Net::Daemon::Test (); 12use Fcntl (); 13use Config (); 14 15 16$| = 1; 17$^W = 1; 18 19 20if (!eval { require threads }) { 21 print "1..0\n"; 22 exit 0; 23} 24 25 26my($handle, $port); 27if (@ARGV) { 28 $port = shift @ARGV; 29} else { 30 ($handle, $port) = Net::Daemon::Test->Child 31 (10, $^X, '-Iblib/lib', '-Iblib/arch', 't/server', 32 '--mode=ithreads', 'logfile=stderr', 'debug'); 33} 34 35 36sub IsNum { 37 my $str = shift; 38 (defined($str) && $str =~ /(\d+)/) ? $1 : undef; 39} 40 41 42sub ReadWrite { 43 my $fh = shift; my $i = shift; my $j = shift; 44 die "Child $i: Error while writing $j: $!" 45 unless $fh->print("$j\n") and $fh->flush(); 46 my $line = $fh->getline(); 47 die "Child $i: Error while reading: " . $fh->error() . " ($!)" 48 unless defined($line); 49 my $num = IsNum($line); 50 die "Child $i: Cannot parse result: $line" 51 unless defined($num); 52 die "Child $i: Expected " . ($j*2) . ", got $num" 53 unless ($num == $j*2); 54} 55 56 57sub MyChild { 58 my $i = shift; 59 60 eval { 61 my $fh = IO::Socket::INET->new('PeerAddr' => '127.0.0.1', 62 'PeerPort' => $port); 63 die "Cannot connect: $!" unless defined($fh); 64 for (my $j = 0; $j < 1000; $j++) { 65 ReadWrite($fh, $i, $j); 66 } 67 }; 68 if ($@) { 69 print STDERR $@; 70 return 0; 71 } 72 return 1; 73} 74 75 76my @threads; 77for (my $i = 0; $i < 10; $i++) { 78 #print "Spawning child $i.\n"; 79 my $tid = threads->new(\&MyChild, $i); 80 if (!$tid) { 81 print STDERR "Failed to create new thread: $!\n"; 82 exit 1; 83 } 84 push(@threads, $tid); 85} 86eval { alarm 1; alarm 0 }; 87alarm 120 unless $@; 88for (my $i = 1; $i <= 10; $i++) { 89 my $tid = shift @threads; 90 if ($tid->join()) { 91 print "ok $i\n"; 92 } else { 93 print "not ok $i\n"; 94 } 95} 96 97END { 98 if ($handle) { 99 print "Terminating server.\n"; 100 $handle->Terminate(); 101 undef $handle; 102 } 103 unlink "ndtest.prt"; 104} 105