Merge pull request #1844 from jrw972/monterey
[ACE_TAO.git] / TAO / tests / Bug_3000_Regression / run_test.pl
blob981560a183ae1d6aba029b81dc90fa6b2e54e0c9
1 eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}'
2 & eval 'exec perl -S $0 $argv:q'
3 if 0;
5 # -*- perl -*-
7 use lib "$ENV{ACE_ROOT}/bin";
8 use PerlACE::TestTarget;
10 $status = 0;
11 $debug_level = '0';
13 foreach $i (@ARGV) {
14 if ($i eq '-debug') {
15 $debug_level = '10';
19 my $server = PerlACE::TestTarget::create_target (1) || die "Create target 1 failed\n";
20 my $client1 = PerlACE::TestTarget::create_target (2) || die "Create target 2 failed\n";
21 my $client2 = PerlACE::TestTarget::create_target (3) || die "Create target 3 failed\n";
23 my $iorfile = "test.ior";
25 #Files which used by server
26 my $server_iorfile = $server->LocalFile ($iorfile);
27 $server->DeleteFile($iorfile);
29 my $base_conf = "rw" . $PerlACE::svcconf_ext;
30 my $server_conf = $server->LocalFile ($base_conf);
32 if ($server->PutFile ($base_conf) == -1) {
33 print STDERR "ERROR: cannot set file <$server_conf>\n";
34 exit 1;
37 #Files which used by client1
38 my $client1_iorfile = $client1->LocalFile ($iorfile);
39 $client1->DeleteFile($iorfile);
41 #Files which used by client2
42 my $client2_iorfile = $client2->LocalFile ($iorfile);
43 $client2->DeleteFile($iorfile);
45 $SV = $server->CreateProcess ("server",
46 "-ORBdebuglevel $debug_level " .
47 "-ORBSvcConf $server_conf " .
48 "-o $server_iorfile");
50 $port1 = $client1->RandomPort ();
52 $CL1 = $client1->CreateProcess ("client",
53 "-k file://$client1_iorfile " .
54 "-ORBDottedDecimalAddresses 1 " .
55 "-ORBEndpoint iiop://:$port1");
57 $port2 = $client2->RandomPort ();
59 $CL2 = $client2->CreateProcess ("client",
60 "-s " .
61 "-k file://$client2_iorfile " .
62 "-ORBDottedDecimalAddresses 2 " .
63 "-ORBEndpoint iiop://:$port2");
65 $server_status = $SV->Spawn ();
67 if ($server_status != 0) {
68 print STDERR "ERROR: server returned $server_status\n";
69 exit 1;
72 if ($server->WaitForFileTimed ($iorfile,
73 $server->ProcessStartWaitInterval()) == -1) {
74 print STDERR "ERROR: cannot find file <$server_iorfile>\n";
75 $SV->Kill (); $SV->TimedWait (1);
76 exit 1;
79 if ($server->GetFile ($iorfile) == -1) {
80 print STDERR "ERROR: cannot retrieve file <$server_iorfile>\n";
81 $SV->Kill (); $SV->TimedWait (1);
82 exit 1;
85 if ($client1->PutFile ($iorfile) == -1) {
86 print STDERR "ERROR: cannot set file <$client1_iorfile>\n";
87 $SV->Kill (); $SV->TimedWait (1);
88 exit 1;
91 if ($client2->PutFile ($iorfile) == -1) {
92 print STDERR "ERROR: cannot set file <$client2_iorfile>\n";
93 $SV->Kill (); $SV->TimedWait (1);
94 exit 1;
97 $client_status = $CL1->SpawnWaitKill ($client1->ProcessStartWaitInterval() + 45);
99 # The client crashes, therefore it normally exists with status != 0,
100 # but a status of -1 would be a serious error.
101 if ($client_status == -1) {
102 print STDERR "ERROR: client returned $client_status\n";
103 $status = 1;
106 $client_status = $CL2->SpawnWaitKill ($client2->ProcessStartWaitInterval() + 45);
108 # The client crashes, therefore it normally exists with status != 0,
109 # but a status of -1 would be a serious error.
110 if ($client_status == -1) {
111 print STDERR "ERROR: client returned $client_status\n";
112 $status = 1;
115 $server_status = $SV->WaitKill ($server->ProcessStopWaitInterval());
117 if ($server_status != 0) {
118 print STDERR "ERROR: server returned $server_status\n";
119 $status = 1;
122 $server->DeleteFile($iorfile);
123 $client1->DeleteFile($iorfile);
124 $client2->DeleteFile($iorfile);
126 exit $status;