TAO/tests/Alt_Mapping/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 $iorbase = "server.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 $invocation = "sii";
  20 $num = 5;
  21 $debug = "";
  22 $status = 0;
  23
  24 # Parse the arguments
  25
  26 @types = ("ubstring", "ub_struct_seq");
  27
  28
  29 for ($i = 0; $i <= $#ARGV; $i++) {
  30     if ($ARGV[$i] eq "-h" || $ARGV[$i] eq "-?") {
  31       print "Run_Test Perl script for TAO Param Test\n\n";
  32       print "run_test [-n num] [-d] [-h] [-t type] [-i (dii|sii)]\n";
  33       print "\n";
  34       print "-n num              -- runs the client num times\n";
  35       print "-d                  -- runs each in debug mode\n";
  36       print "-h                  -- prints this information\n";
  37       print "-t type             -- runs only one type of param test\n";
  38       print "-i (dii|sii)        -- Changes the type of invocation\n";
  39       exit 0;
  40     }
  41     elsif ($ARGV[$i] eq "-n") {
  42       $num = $ARGV[$i + 1];
  43       $i++;
  44     }
  45     elsif ($ARGV[$i] eq "-d") {
  46       $debug = $debug." -d";
  47     }
  48     elsif ($ARGV[$i] eq "-t") {
  49       @types = split (',', $ARGV[$i + 1]);
  50       $i++;
  51     }
  52     elsif ($ARGV[$i] eq "-i") {
  53       $invocation = $ARGV[$i + 1];
  54       $i++;
  55     }
  56 }
  57
  58 $SV = $server->CreateProcess ("server", "$debug -o $server_iorfile");
  59 $CL = $client->CreateProcess ("client");
  60
  61 foreach $type (@types) {
  62     $server->DeleteFile($iorbase); # Ignore errors
  63     $client->DeleteFile($iorbase);
  64
  65     print STDERR "==== Testing $type === wait....\n";
  66
  67     $server_status = $SV->Spawn ();
  68
  69     if ($server_status != 0) {
  70         print STDERR "ERROR: server returned $server_status\n";
  71         $status = 1;
  72     } else {
  73         if ($server->WaitForFileTimed ($iorbase,
  74                                        $server->ProcessStartWaitInterval()) == -1) {
  75             print STDERR "ERROR: cannot find file <$server_iorfile>\n";
  76             $SV->Kill ();
  77             exit 1;
  78         }
  79
  80         if ($server->GetFile ($iorbase) == -1) {
  81             print STDERR "ERROR: cannot retrieve file <$server_iorfile>\n";
  82             $SV->Kill (); $SV->TimedWait (1);
  83             exit 1;
  84         }
  85         if ($client->PutFile ($iorbase) == -1) {
  86             print STDERR "ERROR: cannot set file <$client_iorfile>\n";
  87             $SV->Kill (); $SV->TimedWait (1);
  88             exit 1;
  89         }
  90
  91         $CL->Arguments ("$debug -f $client_iorfile  -i $invocation -t $type -n $num -x");
  92         $client_status = $CL->SpawnWaitKill ($server->ProcessStartWaitInterval() + 45);
  93
  94         if ($client_status != 0) {
  95             print STDERR "ERROR: client returned $client_status\n";
  96             $status = 1;
  97         }
  98
  99         $server_status = $SV->WaitKill ($server->ProcessStopWaitInterval());
 100
 101         if ($server_status != 0) {
 102             print STDERR "ERROR: server returned $server_status\n";
 103             $status = 1;
 104         }
 105
 106         $server->GetStderrLog();
 107     }
 108
 109     $server->DeleteFile($iorbase);
 110     $client->DeleteFile($iorbase);
 111
 112     print STDERR "==== Test for $type finished ===\n";
 113 }
 114
 115 $server->DeleteFile($iorbase);
 116
 117 exit $status;