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