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