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