TAO/tests/RTCORBA/Policy_Combinations/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
  12 my $server = PerlACE::TestTarget::create_target (1) || die "Create target 1 failed\n";
  13 my $client = PerlACE::TestTarget::create_target (2) || die "Create target 2 failed\n";
  14
  15 my $svc_conf = 'svc.conf';
  16
  17 # copy the configuation files
  18 if ($server->PutFile ($svc_conf) == -1) {
  19     print STDERR "ERROR: cannot set file <".$server->LocalFile ($svc_conf).">\n";
  20     exit 1;
  21 }
  22 if ($server->PutFile ($svc_conf.'.xml') == -1) {
  23     print STDERR "ERROR: cannot set file <".$server->LocalFile ($svc_conf.'.xml').">\n";
  24     exit 1;
  25 }
  26 if ($client->PutFile ($svc_conf) == -1) {
  27     print STDERR "ERROR: cannot set file <".$client->LocalFile ($svc_conf).">\n";
  28     exit 1;
  29 }
  30 if ($client->PutFile ($svc_conf.'.xml') == -1) {
  31     print STDERR "ERROR: cannot set file <".$client->LocalFile ($svc_conf.'.xml').">\n";
  32     exit 1;
  33 }
  34
  35 @iorfiles =
  36     (
  37      "root",
  38      "child",
  39      "default_pool_no_bands_client_propagated",
  40      "default_pool_no_bands_server_declared",
  41      "no_lanes_no_bands_client_propagated",
  42      "no_lanes_no_bands_server_declared",
  43      "lanes_no_bands_client_propagated",
  44      "lanes_no_bands_server_declared",
  45      "default_pool_bands_client_propagated",
  46      "default_pool_bands_server_declared",
  47      "no_lanes_bands_client_propagated",
  48      "no_lanes_bands_server_declared",
  49      "lanes_bands_client_propagated",
  50      "lanes_bands_server_declared",
  51      );
  52
  53 sub run_client
  54 {
  55     $CL = $client->CreateProcess ("client", @_);
  56
  57     $CL->Spawn ();
  58
  59     $client_status = $CL->WaitKill ($client->ProcessStartWaitInterval ());
  60
  61     if ($client_status != 0) {
  62         print STDERR "ERROR: client returned $client_status\n";
  63         $status = 1;
  64         goto kill_server;
  65     }
  66 }
  67
  68 for $file (@iorfiles) {
  69     $server->DeleteFile ($file);
  70 }
  71
  72 $SV = $server->CreateProcess ("server");
  73
  74 $SV->Spawn ();
  75
  76 for $file (@iorfiles) {
  77     $server_iorfile = $server->LocalFile ($file);
  78     $client_iorfile = $server->LocalFile ($file);
  79     if ($server->WaitForFileTimed ($file,
  80                                    $server->ProcessStartWaitInterval()) == -1) {
  81         $server_status = $SV->TimedWait (1);
  82         if ($server_status == 2) {
  83             # Mark as no longer running to avoid errors on exit.
  84             $SV->{RUNNING} = 0;
  85             exit $status;
  86         }
  87         else {
  88             print STDERR "ERROR: cannot find ior file: $server_iorfile\n";
  89             $status = 1;
  90             goto kill_server;
  91         }
  92     }
  93
  94     print STDERR "\n******************************************************\n";
  95     print STDERR "Invoking methods on servant in $file poa\n";
  96     print STDERR "******************************************************\n\n";
  97
  98     run_client ("-k file://$client_iorfile");
  99 }
 100
 101 print STDERR "\n**************************\n";
 102 print STDERR "Shutting down the server\n";
 103 print STDERR "**************************\n\n";
 104
 105 $ior_file = $client->LocalFile ($iorfiles[0]);
 106 run_client ("-k file://$ior_file -i 0 -x");
 107
 108 kill_server:
 109     print STDERR "Killing server...\n";
 110     $server_status = $SV->Kill ($server->ProcessStopWaitInterval ());
 111
 112     if ($server_status != 0) {
 113         print STDERR "ERROR: server returned $server_status\n";
 114         $status = 1;
 115     }
 116
 117     for $file (@iorfiles) {
 118         $server->DeleteFile ($file);
 119     }
 120
 121 exit $status;