Merge pull request #2306 from mitza-oci/warnings
[ACE_TAO.git] / TAO / examples / RTScheduling / Fixed_Priority_Scheduler / run_test.pl
blobcab82541f9a66aa128c5ca9b66ec7f22f83118c7
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 $client = PerlACE::TestTarget::create_target (2) || die "Create target 2 failed\n";
21 my $nstarget = PerlACE::TestTarget::create_target (3) || die "Create target 3 failed\n";
22 my $starter = PerlACE::TestTarget::create_target (4) || die "Create target 4 failed\n";
24 $server->AddLibPath ('..');
25 $client->AddLibPath ('..');
26 $starter->AddLibPath ('..');
28 my $iorbase = "ns.ior";
29 my $s_svcbase = "svc$PerlACE::svcconf_ext.server";
30 my $c_svcbase = "svc$PerlACE::svcconf_ext.client";
31 my $server_iorfile = $server->LocalFile ($iorbase);
32 my $server_svcfile = $server->LocalFile ($s_svcbase);
33 my $client_iorfile = $client->LocalFile ($iorbase);
34 my $client_svcfile = $client->LocalFile ($c_svcbase);
35 my $nstarget_iorfile = $nstarget->LocalFile ($iorbase);
36 my $starter_iorfile = $starter->LocalFile ($iorbase);
37 $server->DeleteFile($iorbase);
38 $client->DeleteFile($iorbase);
39 $nstarget->DeleteFile($iorbase);
40 $starter->DeleteFile($iorbase);
42 $NS = $nstarget->CreateProcess ("$ENV{TAO_ROOT}/orbsvcs/Naming_Service/tao_cosnaming",
43 "-o $nstarget_iorfile");
44 $SV = $server->CreateProcess ("test",
45 "-ORBInitRef NameService=file://$server_iorfile ".
46 "-ORBSvcConf $server_svcfile -ORBDebugLevel $debug_level");
47 $CL = $client->CreateProcess ("test",
48 "-ORBInitRef NameService=file://$client_iorfile ".
49 "-ORBSvcConf $client_svcfile");
50 $ST = $starter->CreateProcess ("Starter",
51 "-ORBInitRef NameService=file://$starter_iorfile");
53 print STDERR "Starting Naming Service\n";
55 $nstarget_status = $NS->Spawn ();
57 if ($nstarget_status != 0) {
58 print STDERR "ERROR: ns returned $nstarget_status\n";
59 exit 1;
62 if ($nstarget->WaitForFileTimed ($iorbase,
63 $nstarget->ProcessStartWaitInterval()) == -1) {
64 print STDERR "ERROR: cannot find file <$nstarget_iorfile>\n";
65 $NS->Kill (); $NS->TimedWait (1);
66 exit 1;
69 if ($nstarget->GetFile ($iorbase) == -1) {
70 print STDERR "ERROR: cannot retrieve file <$nstarget_iorfile>\n";
71 $NS->Kill (); $NS->TimedWait (1);
72 exit 1;
74 if ($server->PutFile ($iorbase) == -1) {
75 print STDERR "ERROR: cannot set file <$server_iorfile>\n";
76 $NS->Kill (); $NS->TimedWait (1);
77 exit 1;
79 if ($client->PutFile ($iorbase) == -1) {
80 print STDERR "ERROR: cannot set file <$client_iorfile>\n";
81 $NS->Kill (); $NS->TimedWait (1);
82 exit 1;
84 if ($starter->PutFile ($iorbase) == -1) {
85 print STDERR "ERROR: cannot set file <$starter_iorfile>\n";
86 $NS->Kill (); $NS->TimedWait (1);
87 exit 1;
90 print STDERR "Starting Test 1\n";
92 $server_status = $SV->Spawn ();
94 if ($server_status != 0) {
95 print STDERR "ERROR: server returned $server_status\n";
96 $NS->Kill (); $NS->TimedWait (1);
97 exit 1;
100 sleep (10);
102 print STDERR "Starting Test 2\n";
104 $client_status = $CL->Spawn ();
106 if ($client_status != 0) {
107 print STDERR "ERROR: client returned $client_status\n";
108 $NS->Kill (); $NS->TimedWait (1);
109 $SV->Kill (); $SV->TimedWait (1);
110 exit 1;
113 sleep (5);
115 $starter_status = $ST->SpawnWaitKill ($starter->ProcessStartWaitInterval() + 185);
117 if ($starter_status != 0) {
118 print STDERR "ERROR: starter returned $starter_status\n";
119 $NS->Kill (); $NS->TimedWait (1);
120 $SV->Kill (); $SV->TimedWait (1);
121 $CL->Kill (); $CL->TimedWait (1);
122 exit 1;
125 $server_status = $SV->TerminateWaitKill ($server->ProcessStopWaitInterval() + 15);
127 if ($server_status != 0) {
128 print STDERR "ERROR: server returned $server_status\n";
129 $status = 1;
132 $client_status = $CL->TerminateWaitKill ($client->ProcessStopWaitInterval() + 15);
134 if ($client_status != 0) {
135 print STDERR "ERROR: client returned $client_status\n";
136 $status = 1;
139 $nstarget_status = $NS->TerminateWaitKill ($nstarget->ProcessStopWaitInterval());
141 if ($nstarget_status != 0) {
142 print STDERR "ERROR: ns returned $nstarget_status\n";
143 $status = 1;
146 $server->DeleteFile($iorbase);
147 $client->DeleteFile($iorbase);
148 $nstarget->DeleteFile($iorbase);
149 $starter->DeleteFile($iorbase);
151 exit $status;