TAO/tests/NestedUpcall/Triangle_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 $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 $server_a = PerlACE::TestTarget::create_target (1) || die "Create target 1 failed\n";
  20 my $server_b = PerlACE::TestTarget::create_target (2) || die "Create target 2 failed\n";
  21 my $client = PerlACE::TestTarget::create_target (3) || die "Create target 3 failed\n";
  22
  23 my $ior1file = "servera.ior";
  24 my $ior2file = "serverb.ior";
  25
  26 #Files which used by server_a
  27 my $server_a_ior1file = $server_a->LocalFile ($ior1file);
  28 $server_a->DeleteFile ($ior1file);
  29
  30 #Files which used by server_b
  31 my $server_b_ior2file = $server_b->LocalFile ($ior2file);
  32 $server_b->DeleteFile ($ior2file);
  33
  34 #Files which used by client
  35 my $client_ior1file = $client->LocalFile ($ior1file);
  36 my $client_ior2file = $client->LocalFile ($ior2file);
  37 $client->DeleteFile($ior1file);
  38 $client->DeleteFile($ior2file);
  39
  40 $SV1 = $server_a->CreateProcess ("server_A",
  41                               "-ORBdebuglevel $debug_level " .
  42                               "-o $server_a_ior1file ");
  43
  44 $SV2 = $server_b->CreateProcess ("server_B",
  45                               "-ORBdebuglevel $debug_level " .
  46                               "-o $server_b_ior2file ");
  47
  48 $CL = $client->CreateProcess ("initiator",
  49                               "-ORBdebuglevel $debug_level " .
  50                               "-f $client_ior1file " .
  51                               "-g $client_ior2file ");
  52
  53 $server_status = $SV1->Spawn ();
  54
  55 if ($server_status != 0) {
  56     print STDERR "ERROR: server returned $server_status\n";
  57     exit 1;
  58 }
  59
  60 $server_status = $SV2->Spawn ();
  61
  62 if ($server_status != 0) {
  63     print STDERR "ERROR: server returned $server_status\n";
  64     exit 1;
  65 }
  66
  67 sub KillServers{
  68     $SV1->Kill (); $SV1->TimedWait (1);
  69     $SV2->Kill (); $SV2->TimedWait (1);
  70 }
  71
  72 if ($server_a->WaitForFileTimed ($ior1file,
  73                                $server_a->ProcessStartWaitInterval()) == -1) {
  74     print STDERR "ERROR: cannot find file <$server_a_ior1file>\n";
  75     KillServers();
  76     exit 1;
  77 }
  78
  79 if ($server_b->WaitForFileTimed ($ior2file,
  80                                $server_b->ProcessStartWaitInterval()) == -1) {
  81     print STDERR "ERROR: cannot find file <$server_b_ior2file>\n";
  82     KillServers();
  83     exit 1;
  84 }
  85
  86
  87 if ($server_a->GetFile ($ior1file) == -1) {
  88     print STDERR "ERROR: cannot retrieve file <$server_a_ior1file>\n";
  89     KillServers();
  90     exit 1;
  91 }
  92 if ($client->PutFile ($ior1file) == -1) {
  93     print STDERR "ERROR: cannot set file <$client_ior1file>\n";
  94     KillServers();
  95     exit 1;
  96 }
  97
  98 if ($server_b->GetFile ($ior2file) == -1) {
  99     print STDERR "ERROR: cannot retrieve file <$server_b_ior2file>\n";
 100     KillServers();
 101     exit 1;
 102 }
 103 if ($client->PutFile ($ior2file) == -1) {
 104     print STDERR "ERROR: cannot set file <$client_ior2file>\n";
 105     KillServers();
 106     exit 1;
 107 }
 108
 109 $client_status = $CL->SpawnWaitKill ($client->ProcessStartWaitInterval() + 45);
 110
 111 if ($client_status != 0) {
 112     print STDERR "ERROR: client returned $client_status\n";
 113     $status = 1;
 114 }
 115
 116 $server_status = $SV1->WaitKill ($server_a->ProcessStopWaitInterval());
 117
 118 if ($server_status != 0) {
 119     print STDERR "ERROR: server returned $server_status\n";
 120     $status = 1;
 121 }
 122
 123 $server_status = $SV2->WaitKill ($server_b->ProcessStopWaitInterval());
 124
 125 if ($server_status != 0) {
 126     print STDERR "ERROR: server returned $server_status\n";
 127     $status = 1;
 128 }
 129
 130 $server_a->DeleteFile ($ior1file);
 131 $server_b->DeleteFile ($ior2file);
 132 $client->DeleteFile($ior1file);
 133 $client->DeleteFile($ior2file);
 134
 135 exit $status;