TAO/orbsvcs/tests/Bug_2800_Regression/run_test_federated.pl

   1 eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}'
   2      & eval 'exec perl -S $0 $argv:q'
   3      if 0;
   4
   5 # This is a Perl script that runs a Naming Service test.  It starts
   6 # all the servers and clients as necessary.
   7 # -*- perl -*-
   8
   9 use lib "$ENV{ACE_ROOT}/bin";
  10 use PerlACE::TestTarget;
  11 use Cwd;
  12
  13 $status = 0;
  14 $debug_level = '0';
  15 $quiet = 0;
  16
  17 if ($ARGV[0] eq '-q') {
  18     $quiet = 1;
  19 }
  20
  21 foreach $i (@ARGV) {
  22     if ($i eq '-debug') {
  23         $debug_level = '10';
  24     }
  25 }
  26
  27 # Variables for command-line arguments to client and server
  28 # executables.
  29 my $ns_orb_port1 = 9931;
  30 my $ns_orb_port2 = 9932;
  31 my $ns_endpoint1 = "iiop://localhost:$ns_orb_port1";
  32 my $ns_endpoint2 = "iiop://localhost:$ns_orb_port2";
  33 my $ns1_ior = "ns1.ior";
  34 my $ns2_ior = "ns2.ior";
  35 my $iorbase = "test.ior";
  36
  37 my $ns1 = PerlACE::TestTarget::create_target (1) || die "Create target 1 failed\n";
  38 my $ns2 = PerlACE::TestTarget::create_target (2) || die "Create target 2 failed\n";
  39 my $server = PerlACE::TestTarget::create_target (3) || die "Create target 3 failed\n";
  40 my $client = PerlACE::TestTarget::create_target (4) || die "Create target 4 failed\n";
  41
  42 my $server_iorfile = $server->LocalFile ($iorbase);
  43 my $ns1_iorfile = $ns1->LocalFile ($ns1_ior);
  44 my $ns2_iorfile = $ns2->LocalFile ($ns2_ior);
  45 $server->DeleteFile ($iorbase);
  46 $ns1->DeleteFile ($ns1_ior);
  47 $ns2->DeleteFile ($ns2_ior);
  48
  49 $SV = $server->CreateProcess ("server", "-ORBdebuglevel $debug_level -o $server_iorfile");
  50 $CL = $client->CreateProcess ("client", "");
  51
  52 $NS1 = $ns1->CreateProcess("$ENV{TAO_ROOT}/orbsvcs/Naming_Service/tao_cosnaming",
  53                            "-ORBEndPoint $ns_endpoint1 -o $ns1_iorfile -m 0");
  54 $NS2 = $ns2->CreateProcess("$ENV{TAO_ROOT}/orbsvcs/Naming_Service/tao_cosnaming",
  55                            "-ORBEndPoint $ns_endpoint2 -o $ns2_iorfile -m 0");
  56
  57 # Run two Naming Servers
  58 $process_status = $NS1->Spawn ();
  59
  60 if ($process_status != 0) {
  61     print STDERR "ERROR: ns1 returned $process_status\n";
  62     exit 1;
  63 }
  64
  65 if ($ns1->WaitForFileTimed ($ns1_ior,
  66                             $ns1->ProcessStartWaitInterval()) == -1) {
  67     print STDERR "ERROR: cannot find file <$ns1_iorfile>\n";
  68     $NS1->Kill (); $NS1->TimedWait (1);
  69     exit 1;
  70 }
  71
  72 $process_status = $NS2->Spawn ();
  73
  74 if ($process_status != 0) {
  75     print STDERR "ERROR: ns2 returned $process_status\n";
  76     $NS1->Kill (); $NS1->TimedWait (1);
  77     exit 1;
  78 }
  79
  80 if ($ns2->WaitForFileTimed ($ns2_ior,
  81                             $ns2->ProcessStartWaitInterval()) == -1) {
  82     print STDERR "ERROR: cannot find file <$ns2_iorfile>\n";
  83     $NS2->Kill (); $NS2->TimedWait (1);
  84     $NS1->Kill (); $NS1->TimedWait (1);
  85     exit 1;
  86 }
  87
  88 $process_status = $SV->Spawn ();
  89
  90 if ($process_status != 0) {
  91     print STDERR "ERROR: server returned $process_status\n";
  92     $NS2->Kill (); $NS2->TimedWait (1);
  93     $NS1->Kill (); $NS1->TimedWait (1);
  94     exit 1;
  95 }
  96
  97 if ($server->WaitForFileTimed ($iorbase,
  98                                $server->ProcessStartWaitInterval()) == -1) {
  99     print STDERR "ERROR: cannot find file <$server_iorfile>\n";
 100     $NS2->Kill (); $NS2->TimedWait (1);
 101     $NS1->Kill (); $NS1->TimedWait (1);
 102     $SV->Kill (); $SV->TimedWait (1);
 103     exit 1;
 104 }
 105
 106 print STDERR "Killing second naming server\n";
 107 $NS2->Kill ();
 108
 109 print STDERR "Starting client\n";
 110 $process_status = $CL->Spawn ();
 111
 112 if ($process_status != 0) {
 113     print STDERR "ERROR: client returned $process_status\n";
 114     $status = 1;
 115 }
 116
 117 sleep (15);
 118
 119 $process_status = $SV->TerminateWaitKill ($server->ProcessStopWaitInterval());
 120
 121 if ($process_status != 0) {
 122     print STDERR "ERROR: server returned $process_status\n";
 123     $status = 1;
 124 }
 125
 126 $NS1->Kill ();
 127
 128 $process_status = $CL->TerminateWaitKill ($server->ProcessStopWaitInterval());
 129
 130 if ($process_status != 0) {
 131     print STDERR "ERROR: client returned $process_status\n";
 132     $status = 1;
 133 }
 134
 135 $server->DeleteFile ($iorbase);
 136 $ns1->DeleteFile ($ns1_ior);
 137 $ns2->DeleteFile ($ns2_ior);
 138
 139 exit $status;