TAO/orbsvcs/tests/Bug_2285_Regression/run_test2.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 $debug_level = '0';
  12
  13 foreach $i (@ARGV) {
  14     if ($i eq '-debug') {
  15         $debug_level = '10';
  16     }
  17 }
  18
  19 my $client = PerlACE::TestTarget::create_target (1) || die "Create target 1 failed\n";
  20
  21 my $number_of_servers = 5;
  22
  23 #These files are used only in ServerRequest_Interceptor2.cpp for internal tasks.
  24 my $last_exp_time = "last_expiration_time";
  25 my $no_more_retries = "no_more_retries";
  26
  27 my @iorfiles = ();
  28 my @servers = ();
  29 my @servers_iorfile = ();
  30 my @client_iorfiles = ();
  31 my @SV = ();
  32
  33 for ($i = 0; $i < $number_of_servers + 1; $i++) {
  34     $servers[$i] = PerlACE::TestTarget::create_target ($i + 2) || die "Create target $i + 2 failed\n";
  35     $iorfiles[$i] = "n".$i.".ior";
  36
  37     $servers_iorfile[$i] = $servers[$i]->LocalFile($iorfiles[$i]);
  38     $client_iorfiles[$i] = $client->LocalFile($iorfiles[$i]);
  39
  40     $servers[$i]->DeleteFile ($iorfiles[$i]);
  41     $client->DeleteFile ($iorfiles[$i]);
  42     $servers[$i]->DeleteFile ($last_exp_time);
  43     $servers[$i]->DeleteFile ($no_more_retries);
  44
  45     $SV [$i] = $servers[$i]->CreateProcess("server2", "-n $i");
  46 }
  47
  48 $CL = $client->CreateProcess ("client2", " -n $number_of_servers");
  49
  50 sub wait_get_send_ior {
  51     my $number = $_[0];
  52     if ($servers[$number]->WaitForFileTimed ($iorfiles[$number],
  53                                              $servers[$number]->ProcessStartWaitInterval()) == -1) {
  54         print STDERR "ERROR: cannot find file <$servers[$number]_iorfile>\n";
  55         return 1;
  56     }
  57
  58     if ($servers[$number]->GetFile ($iorfiles[$number]) == -1) {
  59         print STDERR "ERROR: cannot retrieve file <$servers[$number]_iorfile>\n";
  60         return 1;
  61     }
  62
  63     if ($client->PutFile ($iorfiles[$number]) == -1) {
  64         print STDERR "ERROR: cannot set file <$client_iorfiles[$number]>\n";
  65         return 1;
  66     }
  67
  68     return 0;
  69 }
  70
  71 for($i = 0; $i < $number_of_servers; $i++) {
  72     $process_status = $SV[$i]->Spawn ();
  73     if ($process_status != 0) {
  74         print STDERR "ERROR: server $i returned $process_status\n";
  75         for ($j = 0; $j < $i + 1; $j++) {
  76             $SV[$j]->Kill (); $SV[$j]->TimedWait (1);
  77         }
  78         exit 1;
  79     }
  80 }
  81
  82 # Loops are cheap.
  83 for ($i = 0; $i < $number_of_servers; $i++) {
  84     $result = wait_get_send_ior($i);
  85
  86     if ($result != 0) {
  87         for ($j = 0; $j < $i + 1; $j++) {
  88             $SV[$j]->Kill (); $SV[$j]->TimedWait (1);
  89         }
  90         exit 1;
  91     }
  92 }
  93
  94 $client_status = $CL->SpawnWaitKill ($client->ProcessStartWaitInterval() + 285);
  95
  96 if ($client_status != 0) {
  97     print STDERR "ERROR: client returned $client_status\n";
  98     $status = 1;
  99 }
 100
 101
 102 for ($i = 0; $i < $number_of_servers; $i++) {
 103     $server_status = $SV[$i]->WaitKill ($servers[$i]->ProcessStopWaitInterval(), {self_crash => 1});
 104
 105     if ($server_status < 0) {
 106         print STDERR "ERROR: server $i returned $server_status\n";
 107         $status = 1;
 108     }
 109
 110     $servers[$i]->DeleteFile ($iorfiles[$i]);
 111     $client->DeleteFile ($iorfiles[$i]);
 112     $servers[$i]->DeleteFile ($last_exp_time);
 113     $servers[$i]->DeleteFile ($no_more_retries);
 114 }
 115
 116 exit $status;