TAO/tests/RTCORBA/Linear_Priority/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 $iorbase = "ior";
  14 my $server_iorfile = $server->LocalFile ($iorbase);
  15 my $client_iorfile = $client->LocalFile ($iorbase);
  16 $server->DeleteFile($iorbase);
  17 $client->DeleteFile($iorbase);
  18
  19 my $svc_conf = 'svc.conf';
  20
  21 # copy the configuation files
  22 if ($server->PutFile ($svc_conf) == -1) {
  23     print STDERR "ERROR: cannot set file <".$server->LocalFile ($svc_conf).">\n";
  24     exit 1;
  25 }
  26 if ($server->PutFile ($svc_conf.'.xml') == -1) {
  27     print STDERR "ERROR: cannot set file <".$server->LocalFile ($svc_conf.'.xml').">\n";
  28     exit 1;
  29 }
  30 if ($client->PutFile ($svc_conf) == -1) {
  31     print STDERR "ERROR: cannot set file <".$client->LocalFile ($svc_conf).">\n";
  32     exit 1;
  33 }
  34 if ($client->PutFile ($svc_conf.'.xml') == -1) {
  35     print STDERR "ERROR: cannot set file <".$client->LocalFile ($svc_conf.'.xml').">\n";
  36     exit 1;
  37 }
  38 if ($server->PutFile ('bands') == -1) {
  39     print STDERR "ERROR: cannot set file <".$server->LocalFile ('bands').">\n";
  40     exit 1;
  41 }
  42 if ($server->PutFile ('lanes') == -1) {
  43     print STDERR "ERROR: cannot set file <".$server->LocalFile ('lanes').">\n";
  44     exit 1;
  45 }
  46 if ($server->PutFile ('empty_file') == -1) {
  47     print STDERR "ERROR: cannot set file <".$server->LocalFile ('empty_file').">\n";
  48     exit 1;
  49 }
  50 if ($server->PutFile ('invocation_priorities') == -1) {
  51     print STDERR "ERROR: cannot set file <".$server->LocalFile ('invocation_priorities').">\n";
  52     exit 1;
  53 }
  54
  55 $status = 0;
  56
  57 @configurations = ({
  58          server => "-b empty_file -l empty_file",
  59          client => "-b empty_file -p empty_file -x",}, {
  60          server => "-b bands -l empty_file",
  61          client => "-b empty_file -p empty_file -x",}, {
  62          server => "-b empty_file -l lanes",
  63          client => "-b empty_file -p empty_file -x",}, {
  64          server => "-b bands -l lanes",
  65          client => "-b empty_file -p empty_file -x",}, {
  66          server => "-b empty_file -l empty_file",
  67          client => "-b bands -p empty_file -x", }, {
  68          server => "-b empty_file -l lanes",
  69          client => "-b bands -p empty_file -x", }, {
  70          server => "-b empty_file -l empty_file",
  71          client => "-b empty_file -p invocation_priorities -x",}, {
  72          server => "-b bands -l empty_file",
  73          client => "-b empty_file -p invocation_priorities -x",}, {
  74          server => "-b bands -l lanes",
  75          client => "-b empty_file -p invocation_priorities -x",}, {
  76          server => "-b empty_file -l empty_file",
  77          client => "-b bands -p invocation_priorities -x",}, {
  78          server => "-b empty_file -l lanes",
  79          client => "-b bands -p invocation_priorities -x",}, );
  80
  81 sub run_client
  82 {
  83     my $arg = shift;
  84     $CL = $client->CreateProcess ("client", "-k file://$client_iorfile " . $arg);
  85
  86     $CL->Spawn ();
  87
  88     $client_status = $CL->WaitKill ($client->ProcessStopWaitInterval ());
  89
  90     if ($client_status != 0) {
  91         print STDERR "ERROR: client returned $client_status\n";
  92         $status = 1;
  93         zap_server (1);
  94     }
  95 }
  96
  97 sub run_server
  98 {
  99     $SV = $server->CreateProcess ("server", @_);
 100     if ($SV->Spawn () == -1) {
 101         exit 1;
 102     }
 103
 104     if ($server->WaitForFileTimed ($iorbase,
 105                   $server->ProcessStartWaitInterval()) == -1) {
 106         check_supported_priorities ($SV);
 107         print STDERR "ERROR: cannot find ior file: $server_iorfile\n";
 108         $status = 1;
 109         zap_server (1);
 110     }
 111 }
 112
 113 sub zap_server
 114 {
 115     $server_status = $SV->WaitKill ($server->ProcessStopWaitInterval ());
 116
 117     if ($server_status != 0) {
 118         print STDERR "ERROR: server returned $server_status\n";
 119         $status = 1;
 120     }
 121
 122     $server->DeleteFile($iorbase);
 123     $client->DeleteFile($iorbase);
 124
 125     if ($_[0]) {
 126         exit $status;
 127     }
 128 }
 129
 130 sub check_supported_priorities
 131 {
 132     $process = shift;
 133     $returnVal = $process->TimedWait (1);
 134     if ($returnVal == 2) {
 135         # Mark as no longer running to avoid errors on exit.
 136         $process->{RUNNING} = 0;
 137         exit 0;
 138     }
 139 }
 140
 141 for $test (@configurations) {
 142     print STDERR "\n******************************************************\n";
 143
 144     $server->DeleteFile($iorbase);
 145     $client->DeleteFile($iorbase);
 146
 147     run_server ($test->{server});
 148
 149     run_client ($test->{client});
 150
 151     zap_server (0);
 152 }
 153
 154 exit $status;