TAO/tests/RTCORBA/Bug_3643_Regression/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 my $server = PerlACE::TestTarget::create_target (1) || die "Create target 1 failed\n";
  11 my $client = PerlACE::TestTarget::create_target (2) || die "Create target 2 failed\n";
  12
  13 $number_of_clients = 4;
  14 $status = 0;
  15
  16 @configurations =
  17     ({
  18         file => "ior_1",
  19         description => "Invoking methods on servant in default thread pool",
  20      },{
  21         file => "ior_2",
  22         description => "Invoking methods on servant in first RT thread pool (without lanes)",
  23      },{
  24         file => "ior_3",
  25         description => "Invoking methods on servant in second RT thread pool (with lanes)",
  26      },
  27      );
  28
  29 for $test (@configurations) {
  30     $server->DeleteFile ($test->{file});
  31     $client->DeleteFile ($test->{file});
  32 }
  33
  34 sub run_clients
  35 {
  36     my @parms = @_;
  37     $arg = $parms[0];
  38     $clients = $parms[1];
  39
  40
  41     for ($i = 0; $i < $clients; $i++) {
  42         $CL[$i] = $client->CreateProcess ("client", $arg);
  43         $CL[$i]->Spawn ();
  44     }
  45
  46     for ($i = 0; $i < $clients; $i++) {
  47         $client_status = $CL[$i]->WaitKill ($client->ProcessStopWaitInterval (120));
  48         if ($client_status != 0) {
  49             print STDERR "ERROR: client returned $client_status\n";
  50             $status = 1;
  51             goto kill_server;
  52         }
  53     }
  54     print STDERR "Finished running clients";
  55 }
  56
  57 $SV = $server->CreateProcess ("server");
  58
  59 $SV->Spawn ();
  60
  61 for $test (@configurations) {
  62     if ($server->WaitForFileTimed ($test->{file},
  63                                $server->ProcessStartWaitInterval()) == -1) {
  64         $server_status = $SV->TimedWait (1);
  65         if ($server_status == 2) {
  66             # Mark as no longer running to avoid errors on exit.
  67             $SV->{RUNNING} = 0;
  68             exit $status;
  69         }
  70         else {
  71             print STDERR "ERROR: cannot find ior file: $test->{file}\n";
  72             $status = 1;
  73             goto kill_server;
  74         }
  75     }
  76 }
  77
  78 for $test (@configurations) {
  79     print STDERR "\n*************************************************************\n";
  80     print STDERR "$test->{description}\n";
  81     print STDERR "*************************************************************\n\n";
  82
  83     $iorfile = $client->LocalFile ($test->{file});
  84     run_clients ("-k file://$iorfile", $number_of_clients);
  85     print STDERR "Prepare next cycle";
  86 }
  87
  88 print STDERR "\n************************\n";
  89 print STDERR "Shutting down the server\n";
  90 print STDERR "************************\n\n";
  91
  92 $client_iorfile = $client->LocalFile ($configurations[0]->{file});
  93 run_clients ("-k file://$client_iorfile -i 0 -x", 1);
  94
  95 kill_server:
  96
  97 $server_status = $SV->WaitKill ($server->ProcessStopWaitInterval () + (2 * $number_of_clients * 100));
  98
  99 if ($server_status != 0) {
 100     print STDERR "ERROR: server returned $server_status\n";
 101     $status = 1;
 102 }
 103
 104 for $test (@configurations) {
 105     $client->DeleteFile ($test->{file});
 106     $server->DeleteFile ($test->{file});
 107 }
 108
 109 exit $status