TAO/DevGuideExamples/Multithreading/GracefulShutdown/run_test.pl

   1 eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}'
   2      & eval 'exec perl -S $0 $argv:q'
   3      if 0;
   4
   5 # -*- perl -*-
   6
   7 use lib "$ENV{ACE_ROOT}/bin";
   8 use PerlACE::TestTarget;
   9
  10 $status = 0;
  11 $debug_level = '0';
  12
  13 foreach $i (@ARGV) {
  14     if ($i eq '-debug') {
  15         $debug_level = '10';
  16     }
  17 }
  18
  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
  22 my $iorbase = "server.ior";
  23 my $server_iorfile = $server->LocalFile ($iorbase);
  24 my $client_iorfile = $client->LocalFile ($iorbase);
  25 $server->DeleteFile($iorbase);
  26 $client->DeleteFile($iorbase);
  27
  28 my $hostname = $server->HostName ();
  29 my $server_args = "-ORBdebuglevel $debug_level " .
  30     "-ORBListenEndpoints iiop://$hostname -o $server_iorfile";
  31
  32 $SV = $server->CreateProcess ("MessengerServer",
  33                               $server_args . " -x");
  34 $CL = $client->CreateProcess ("MessengerClient",
  35                               "-k file://$client_iorfile -x");
  36
  37 # -------------------------------------------------------------------
  38 # Test 1: Shutdown on client invocation
  39 # -------------------------------------------------------------------
  40
  41 print STDOUT "\n\nTest 1: Shutdown on client invocation.\n";
  42 print STDOUT "Running MessengerServer...\n";
  43
  44 $server_status = $SV->Spawn ();
  45
  46 if ($server_status != 0) {
  47     print STDERR "ERROR: server returned $server_status\n";
  48     exit 1;
  49 }
  50
  51 if ($server->WaitForFileTimed ($iorbase,
  52                                $server->ProcessStartWaitInterval()) == -1) {
  53     print STDERR "ERROR: cannot find file <$server_iorfile>\n";
  54     $SV->Kill (); $SV->TimedWait (1);
  55     exit 1;
  56 }
  57
  58 if ($server->GetFile ($iorbase) == -1) {
  59     print STDERR "ERROR: cannot retrieve file <$server_iorfile>\n";
  60     $SV->Kill (); $SV->TimedWait (1);
  61     exit 1;
  62 }
  63 if ($client->PutFile ($iorbase) == -1) {
  64     print STDERR "ERROR: cannot set file <$client_iorfile>\n";
  65     $SV->Kill (); $SV->TimedWait (1);
  66     exit 1;
  67 }
  68
  69 $client_status = $CL->SpawnWaitKill ($client->ProcessStartWaitInterval());
  70
  71 if ($client_status != 0) {
  72     print STDERR "ERROR: client returned $client_status\n";
  73     $status = 1;
  74 }
  75
  76 $server_status = $SV->WaitKill ($server->ProcessStopWaitInterval());
  77
  78 if ($server_status != 0) {
  79     print STDERR "ERROR: server returned $server_status\n";
  80     $status = 1;
  81 }
  82
  83 $server->DeleteFile($iorbase);
  84 $client->DeleteFile($iorbase);
  85
  86 exit $status if ($status != 0);
  87
  88 # -------------------------------------------------------------------
  89 # Test 2: Shutdown after <n> iterations through polling loop
  90 # -------------------------------------------------------------------
  91
  92 my $iter = 10;
  93 print STDOUT "\n\nTest 2: Shutdown after <$iter> iterations through polling loop.\n";
  94 print STDOUT "Running MessengerServer...\n";
  95
  96 $SV->Arguments ($server_args . " -p " . $iter);
  97 $CL->Arguments ("-k file://$client_iorfile");
  98
  99 $server_status = $SV->Spawn ();
 100
 101 if ($server_status != 0) {
 102     print STDERR "ERROR: server returned $server_status\n";
 103     exit 1;
 104 }
 105
 106 if ($server->WaitForFileTimed ($iorbase,
 107                                $server->ProcessStartWaitInterval()) == -1) {
 108     print STDERR "ERROR: cannot find file <$server_iorfile>\n";
 109     $SV->Kill (); $SV->TimedWait (1);
 110     exit 1;
 111 }
 112
 113 if ($server->GetFile ($iorbase) == -1) {
 114     print STDERR "ERROR: cannot retrieve file <$server_iorfile>\n";
 115     $SV->Kill (); $SV->TimedWait (1);
 116     exit 1;
 117 }
 118 if ($client->PutFile ($iorbase) == -1) {
 119     print STDERR "ERROR: cannot set file <$client_iorfile>\n";
 120     $SV->Kill (); $SV->TimedWait (1);
 121     exit 1;
 122 }
 123
 124 $client_status = $CL->SpawnWaitKill ($client->ProcessStartWaitInterval());
 125
 126 if ($client_status != 0) {
 127     print STDERR "ERROR: client returned $client_status\n";
 128     $status = 1;
 129 }
 130
 131 $server_status = $SV->WaitKill ($server->ProcessStopWaitInterval() + $iter);
 132
 133 if ($server_status != 0) {
 134     print STDERR "ERROR: server returned $server_status\n";
 135     $status = 1;
 136 }
 137
 138 $server->DeleteFile($iorbase);
 139 $client->DeleteFile($iorbase);
 140
 141 exit $status if ($status != 0);
 142
 143 # -------------------------------------------------------------------
 144 # Test 3: Schedule a timer with the ORB's reactor to shutdown.
 145 #         in <n> seconds
 146 # -------------------------------------------------------------------
 147
 148 my $sec = 10;
 149 print STDOUT "\n\nTest 3: Schedule a timer with the ORB's reactor to shutdown in <$sec> seconds.\n";
 150 print STDOUT "Running MessengerServer...\n";
 151
 152 $SV->Arguments ($server_args . " -t " . $sec);
 153 $CL->Arguments ("-k file://$client_iorfile");
 154
 155 $server_status = $SV->Spawn ();
 156
 157 if ($server_status != 0) {
 158     print STDERR "ERROR: server returned $server_status\n";
 159     exit 1;
 160 }
 161
 162 if ($server->WaitForFileTimed ($iorbase,
 163                                $server->ProcessStartWaitInterval()) == -1) {
 164     print STDERR "ERROR: cannot find file <$server_iorfile>\n";
 165     $SV->Kill (); $SV->TimedWait (1);
 166     exit 1;
 167 }
 168
 169 if ($server->GetFile ($iorbase) == -1) {
 170     print STDERR "ERROR: cannot retrieve file <$server_iorfile>\n";
 171     $SV->Kill (); $SV->TimedWait (1);
 172     exit 1;
 173 }
 174 if ($client->PutFile ($iorbase) == -1) {
 175     print STDERR "ERROR: cannot set file <$client_iorfile>\n";
 176     $SV->Kill (); $SV->TimedWait (1);
 177     exit 1;
 178 }
 179
 180 $client_status = $CL->SpawnWaitKill ($client->ProcessStartWaitInterval());
 181
 182 if ($client_status != 0) {
 183     print STDERR "ERROR: client returned $client_status\n";
 184     $status = 1;
 185 }
 186
 187 $server_status = $SV->WaitKill ($server->ProcessStopWaitInterval() + $sec);
 188
 189 if ($server_status != 0) {
 190     print STDERR "ERROR: server returned $server_status\n";
 191     $status = 1;
 192 }
 193
 194 $server->DeleteFile($iorbase);
 195 $client->DeleteFile($iorbase);
 196
 197 exit $status if ($status != 0);
 198
 199 # -------------------------------------------------------------------
 200 # Test 4: Use the overloaded version of CORBA::ORB::run() that takes
 201 #         an ACE_Time_Value parameter indicating how long run()
 202 #         should process events before returning.
 203 # -------------------------------------------------------------------
 204
 205 print STDOUT "\n\nTest 4: Use the overloaded version of CORBA::ORB::run()\n";
 206 print STDOUT "that takes an ACE_Time_Value parameter indicating how long\n";
 207 print STDOUT "run() should process events before returning (<$sec> seconds).\n";
 208 print STDOUT "Running MessengerServer...\n";
 209
 210 $SV->Arguments ($server_args . " -r " . $sec);
 211 $CL->Arguments ("-k file://$client_iorfile");
 212
 213 $server_status = $SV->Spawn ();
 214
 215 if ($server_status != 0) {
 216     print STDERR "ERROR: server returned $server_status\n";
 217     exit 1;
 218 }
 219
 220 if ($server->WaitForFileTimed ($iorbase,
 221                                $server->ProcessStartWaitInterval()) == -1) {
 222     print STDERR "ERROR: cannot find file <$server_iorfile>\n";
 223     $SV->Kill (); $SV->TimedWait (1);
 224     exit 1;
 225 }
 226
 227 if ($server->GetFile ($iorbase) == -1) {
 228     print STDERR "ERROR: cannot retrieve file <$server_iorfile>\n";
 229     $SV->Kill (); $SV->TimedWait (1);
 230     exit 1;
 231 }
 232 if ($client->PutFile ($iorbase) == -1) {
 233     print STDERR "ERROR: cannot set file <$client_iorfile>\n";
 234     $SV->Kill (); $SV->TimedWait (1);
 235     exit 1;
 236 }
 237
 238 $client_status = $CL->SpawnWaitKill ($client->ProcessStartWaitInterval());
 239
 240 if ($client_status != 0) {
 241     print STDERR "ERROR: client returned $client_status\n";
 242     $status = 1;
 243 }
 244
 245 $server_status = $SV->WaitKill ($server->ProcessStopWaitInterval() + $sec);
 246
 247 if ($server_status != 0) {
 248     print STDERR "ERROR: server returned $server_status\n";
 249     $status = 1;
 250 }
 251
 252 $server->DeleteFile($iorbase);
 253 $client->DeleteFile($iorbase);
 254
 255 exit $status if ($status != 0);
 256
 257 # -------------------------------------------------------------------
 258 # Test 5: Spawn a separate thread to shutdown the ORB on any
 259 #         input from the console (terminal)
 260 # -------------------------------------------------------------------
 261
 262 print STDOUT "\n\nTest 5: Spawn a separate thread to shutdown the ORB on any input from the console (terminal).\n";
 263 print STDOUT "Running MessengerServer...\n";
 264
 265 $SV->Arguments ($server_args . " -c ");
 266 $CL->Arguments ("-k file://$client_iorfile");
 267
 268 $server_status = $SV->Spawn ();
 269
 270 if ($server_status != 0) {
 271     print STDERR "ERROR: server returned $server_status\n";
 272     exit 1;
 273 }
 274
 275 if ($server->WaitForFileTimed ($iorbase,
 276                                $server->ProcessStartWaitInterval()) == -1) {
 277     print STDERR "ERROR: cannot find file <$server_iorfile>\n";
 278     $SV->Kill (); $SV->TimedWait (1);
 279     exit 1;
 280 }
 281
 282 if ($server->GetFile ($iorbase) == -1) {
 283     print STDERR "ERROR: cannot retrieve file <$server_iorfile>\n";
 284     $SV->Kill (); $SV->TimedWait (1);
 285     exit 1;
 286 }
 287 if ($client->PutFile ($iorbase) == -1) {
 288     print STDERR "ERROR: cannot set file <$client_iorfile>\n";
 289     $SV->Kill (); $SV->TimedWait (1);
 290     exit 1;
 291 }
 292
 293 $client_status = $CL->SpawnWaitKill ($client->ProcessStartWaitInterval());
 294
 295 if ($client_status != 0) {
 296     print STDERR "ERROR: client returned $client_status\n";
 297     $status = 1;
 298 }
 299
 300 print STDOUT "Enter any input to shutdown MessengerServer...\n";
 301 $server_status = $SV->WaitKill ($server->ProcessStopWaitInterval());
 302
 303 if ($server_status != 0) {
 304     print STDERR "ERROR: server returned $server_status\n";
 305     $status = 1;
 306 }
 307
 308 $server->DeleteFile($iorbase);
 309 $client->DeleteFile($iorbase);
 310
 311 exit $status;