TAO/tests/Param_Test/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 = ("short", "ulonglong", "ubstring", "bdstring",
  27           "ubwstring", "bdwstring", "fixed_struct",
  28           "ub_strseq", "bd_strseq", "ub_wstrseq", "bd_wstrseq",
  29           "var_struct", "nested_struct", "recursive_struct",
  30           "ub_struct_seq", "bd_struct_seq",
  31           "ub_array_seq", "bd_array_seq", "multdim_array",
  32           "any", "objref", "objref_sequence", "objref_struct",
  33           "any_sequence",
  34           "ub_short_sequence", "ub_long_sequence",
  35           "bd_short_sequence", "bd_long_sequence",
  36           "fixed_array", "var_array", "typecode", "exception",
  37           "big_union", "small_union", "recursive_union", "complex_any");
  38
  39
  40 for ($i = 0; $i <= $#ARGV; $i++) {
  41     if ($ARGV[$i] eq "-h" || $ARGV[$i] eq "-?") {
  42       print "Run_Test Perl script for TAO Param Test\n\n";
  43       print "run_test [-n num] [-d] [-h] [-t type] [-i (dii|sii)]\n";
  44       print "\n";
  45       print "-n num              -- runs the client num times\n";
  46       print "-d                  -- runs each in debug mode\n";
  47       print "-h                  -- prints this information\n";
  48       print "-t type             -- runs only one type of param test\n";
  49       print "-i (dii|sii)        -- Changes the type of invocation\n";
  50       exit 0;
  51     }
  52     elsif ($ARGV[$i] eq "-n") {
  53       $num = $ARGV[$i + 1];
  54       $i++;
  55     }
  56     elsif ($ARGV[$i] eq "-d") {
  57       $debug = $debug." -d";
  58     }
  59     elsif ($ARGV[$i] eq "-t") {
  60       @types = split (',', $ARGV[$i + 1]);
  61       $i++;
  62     }
  63     elsif ($ARGV[$i] eq "-i") {
  64       $invocation = $ARGV[$i + 1];
  65       $i++;
  66     }
  67 }
  68
  69 $SV = $server->CreateProcess ("server", "$debug -o $server_iorfile");
  70 $CL = $client->CreateProcess ("client");
  71
  72 foreach $type (@types) {
  73     $server->DeleteFile($iorbase); # Ignore errors
  74     $client->DeleteFile($iorbase);
  75
  76     print STDERR "==== Testing $type === wait....\n";
  77
  78     $server_status = $SV->Spawn ();
  79
  80     if ($server_status != 0) {
  81         print STDERR "ERROR: server returned $server_status\n";
  82         $status = 1;
  83     } else {
  84         if ($server->WaitForFileTimed ($iorbase,
  85                                        $server->ProcessStartWaitInterval()) == -1) {
  86             print STDERR "ERROR: cannot find file <$server_iorfile>\n";
  87             $SV->Kill ();
  88             exit 1;
  89         }
  90
  91         if ($server->GetFile ($iorbase) == -1) {
  92             print STDERR "ERROR: cannot retrieve file <$server_iorfile>\n";
  93             $SV->Kill (); $SV->TimedWait (1);
  94             exit 1;
  95         }
  96         if ($client->PutFile ($iorbase) == -1) {
  97             print STDERR "ERROR: cannot set file <$client_iorfile>\n";
  98             $SV->Kill (); $SV->TimedWait (1);
  99             exit 1;
 100         }
 101
 102         $CL->Arguments ("$debug -f $client_iorfile  -i $invocation -t $type -n $num -x");
 103         $client_status = $CL->SpawnWaitKill ($server->ProcessStartWaitInterval() + 45);
 104
 105         if ($client_status != 0) {
 106             print STDERR "ERROR: client returned $client_status\n";
 107             $status = 1;
 108         }
 109
 110         $server_status = $SV->WaitKill ($server->ProcessStopWaitInterval());
 111
 112         if ($server_status != 0) {
 113             print STDERR "ERROR: server returned $server_status\n";
 114             $status = 1;
 115         }
 116
 117         $server->GetStderrLog();
 118     }
 119
 120     $server->DeleteFile($iorbase);
 121     $client->DeleteFile($iorbase);
 122
 123     print STDERR "==== Test for $type finished ===\n";
 124 }
 125
 126 $server->DeleteFile($iorbase);
 127
 128 exit $status;