TAO/orbsvcs/tests/Bug_3444_Regression/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 $is_sciop = 0;
  12
  13 for ($i = 0; $i <= $#ARGV; $i++) {
  14     if ($ARGV[$i] eq "--sciop") {
  15         $is_sciop = 1;
  16     }
  17 }
  18
  19 my $test = PerlACE::TestTarget::create_target (1) || die "Create target 1 failed\n";
  20
  21 $port = $test->RandomPort ();
  22 $multicast = '225.1.1.8';
  23
  24 my $iorbase = "server.ior";
  25 my $test_iorfile = $test->LocalFile ($iorbase);
  26 $test->DeleteFile($iorbase);
  27
  28 my $log = "test.log";
  29 my $log_file = $test->LocalFile ($log);
  30 $test->DeleteFile ($log);
  31
  32 sub run_test {
  33     $test_name = shift;
  34     $test_conf = shift;
  35     $test_c_params = shift;
  36     $test_s_params = shift;
  37
  38     $result = 0;
  39
  40     $test->DeleteFile($iorbase);
  41     $test->DeleteFile($log);
  42
  43     my($svc_conf);
  44     if ($test_conf ne ''){
  45         $tmp_test_conf = $test->LocalFile ($test_conf);
  46         $svc_conf = "-ORBSvcConf $tmp_test_conf";
  47     }
  48
  49     $SV = $test->CreateProcess ("server", " -o $test_iorfile $test_s_params  $svc_conf");
  50     $CL = $test->CreateProcess ("client", "-k file://$test_iorfile " .
  51                                   "$test_c_params $svc_conf " .
  52                                   "-ORBIPHopLimit 1 -ORBDebugLevel 1 -ORBLogFile $log_file");
  53
  54     print STDOUT "Starting $test_name\n";
  55     print STDOUT "  server " . $SV->Arguments () . "\n";
  56
  57     $server_status = $SV->Spawn ();
  58
  59     if ($server_status != 0) {
  60         print STDERR "ERROR: $test_name failed - server returned $server_status\n";
  61         return 1;
  62     }
  63
  64     if ($test->WaitForFileTimed ($iorbase,
  65                                $test->ProcessStartWaitInterval()) == -1) {
  66         print STDERR "ERROR: cannot find file <$test_iorfile>\n";
  67         $SV->Kill (); $SV->TimedWait (1);
  68         exit 1;
  69     }
  70
  71     print STDOUT "  client " . $CL->Arguments () . "\n";
  72
  73     $client_status = $CL->SpawnWaitKill ($test->ProcessStartWaitInterval());
  74
  75     if ($client_status != 0) {
  76         print STDERR "ERROR: $test_name failed - client returned $client_status\n";
  77         $status = 1;
  78     }
  79
  80     $server_status = $SV->WaitKill ($test->ProcessStopWaitInterval());
  81
  82     if ($server_status != 0) {
  83         print STDERR "ERROR: $test_name failed - server returned $server_status\n";
  84         $status = 1;
  85     }
  86
  87     print STDOUT "Client's log:\n";
  88
  89     open (DATA, $log_file);
  90     while ($line = <DATA>) {
  91         # Process the line.
  92         chomp $line;
  93
  94         if ($line =~ /hop limit/) {
  95             print STDERR "ERROR: $line\n";
  96             $result = 1;
  97         } elsif ($line =~ /multicast packets looping/) {
  98             print STDERR "ERROR: $line\n";
  99             $result = 1;
 100         } else {
 101             print STDOUT "$line\n";
 102         }
 103     }
 104     close (DATA);
 105
 106     $test->DeleteFile($iorbase);
 107     $test->DeleteFile($log);
 108
 109     return $result;
 110 }
 111
 112 $status = 0;
 113
 114 %tests = (
 115     "IIOP test"  => [ "", "", "" ],
 116     "DIOP test"  => [ "diop_svc.conf", "", "-ORBListenEndpoints diop://" ],
 117     "UIPMC test" => [ "miop_svc.conf", "-ORBIPMulticastLoop 1",
 118                       "-u corbaloc:miop:1.0\@1.0-cdmwftdomain-1/$multicast:$port" ]
 119 );
 120
 121 if ($is_sciop == 1) {
 122     %tests = (
 123         "SCIOP test" => [ "sciop_svc.conf", "", "-ORBListenEndpoints sciop://" ]
 124     );
 125 }
 126
 127 foreach $test (keys %tests) {
 128     $svc = $tests{$test}[0];
 129     $c_prms = $tests{$test}[1];
 130     $s_prms = $tests{$test}[2];
 131
 132     $status = run_test ($test, $svc, $c_prms, $s_prms);
 133 }
 134
 135 exit $status;