TAO/tests/Bug_3647_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 use strict;
  10
  11 my $verbose = '';
  12 my $mode = 'DELAYED';
  13
  14 foreach my $i (@ARGV) {
  15     if ($i eq '-verbose') {
  16         $verbose = ' -v';
  17     } elsif ($i eq '-none') {
  18         $mode = 'NONE';
  19     } elsif ($i eq '-delayed') {
  20         $mode = 'DELAYED';
  21     } elsif ($i eq '-transport') {
  22         # In this mode, the test is *expected* to fail.  We only run it
  23         # like this to verify that the test is a good test (i.e. it
  24         # detects failures.)  Same comment applies for SERVER and TARGET
  25         # modes.
  26         $mode = 'TRANSPORT';
  27     } elsif ($i eq '-server') {
  28         $mode = 'SERVER';
  29     } elsif ($i eq '-target') {
  30         $mode = 'TARGET';
  31     }
  32 }
  33
  34 my $backend = PerlACE::TestTarget::create_target(1)
  35     or die "Create target 1 failed\n";
  36 my $middle = PerlACE::TestTarget::create_target(2)
  37     or die "Create target 2 failed\n";
  38 my $client = PerlACE::TestTarget::create_target(3)
  39     or die "Create target 3 failed\n";
  40
  41 my $backend_ior = "backend.ior";
  42 my $middle_ior = "middle.ior";
  43
  44 my $backend_iorfile = $backend->LocalFile ($backend_ior);
  45 my $middle_in_iorfile = $middle->LocalFile ($backend_ior);
  46 my $middle_out_iorfile = $middle->LocalFile ($middle_ior);
  47 my $client_in_iorfile = $client->LocalFile ($middle_ior);
  48
  49 $backend->DeleteFile($backend_ior);
  50 $middle->DeleteFile($backend_ior);
  51 $middle->DeleteFile($middle_ior);
  52 $client->DeleteFile($middle_ior);
  53
  54 my $BE =
  55     $backend->CreateProcess ("backend_server",
  56                              " -o $backend_iorfile"
  57                              . $verbose);
  58 my $MD =
  59     $middle->CreateProcess ("middle_server",
  60                             " -s $mode -t 5 "
  61                             ." -o $middle_out_iorfile"
  62                             . $verbose
  63                             . " -k file://$middle_in_iorfile");
  64 my $CL = $client->CreateProcess ("client",
  65                                  " -k file://$client_in_iorfile"
  66                                  ." -t 1 "
  67                                  .$verbose);
  68 my $be_status = $BE->Spawn ();
  69 if ($be_status != 0) {
  70     print STDERR "ERROR: server returned $be_status\n";
  71     exit 1;
  72 }
  73
  74 if ($backend->WaitForFileTimed ($backend_ior,
  75                                 $backend->ProcessStartWaitInterval()) == -1) {
  76     print STDERR "ERROR: cannot find file <$backend_iorfile>\n";
  77     $BE->Kill (); $BE->TimedWait (1);
  78     exit 1;
  79 }
  80
  81 if ($backend->GetFile ($backend_ior) == -1) {
  82     print STDERR "ERROR: cannot retrieve file <$backend_iorfile>\n";
  83     $BE->Kill (); $BE->TimedWait (1);
  84     exit 1;
  85 }
  86
  87 if ($middle->PutFile ($backend_ior) == -1) {
  88     print STDERR "ERROR: cannot set file <$middle_in_iorfile>\n";
  89     $BE->Kill (); $BE->TimedWait (1);
  90     exit 1;
  91 }
  92
  93 my $md_status = $MD->Spawn ();
  94 if ($md_status != 0) {
  95     print STDERR "ERROR: server returned $md_status\n";
  96     $BE->Kill (); $BE->TimedWait (1);
  97     exit 1;
  98 }
  99
 100 if ($middle->WaitForFileTimed ($middle_ior,
 101                                $middle->ProcessStartWaitInterval()) == -1) {
 102     print STDERR "ERROR: cannot find file <$middle_in_iorfile>\n";
 103     $MD->Kill (); $MD->TimedWait (1);
 104     $BE->Kill (); $BE->TimedWait (1);
 105     exit 1;
 106 }
 107
 108 if ($middle->GetFile ($middle_ior) == -1) {
 109     print STDERR "ERROR: cannot retrieve file <$middle_out_iorfile>\n";
 110     $MD->Kill (); $MD->TimedWait (1);
 111     $BE->Kill (); $BE->TimedWait (1);
 112     exit 1;
 113 }
 114
 115 if ($client->PutFile ($middle_ior) == -1) {
 116     print STDERR "ERROR: cannot set file <$client_in_iorfile>\n";
 117     $MD->Kill (); $MD->TimedWait (1);
 118     $BE->Kill (); $BE->TimedWait (1);
 119     exit 1;
 120 }
 121
 122 my $status = 0;
 123 my $client_status =
 124     $CL->SpawnWaitKill ($client->ProcessStartWaitInterval());
 125 if ($client_status != 0) {
 126     print STDERR "ERROR: client returned $client_status\n";
 127     $status = 1;
 128 }
 129
 130 $md_status = $MD->WaitKill ($middle->ProcessStopWaitInterval());
 131 if ($md_status != 0) {
 132     print STDERR "ERROR: middle returned $md_status\n";
 133     $status = 1;
 134 }
 135
 136 $be_status = $BE->WaitKill ($backend->ProcessStopWaitInterval());
 137 if ($be_status != 0) {
 138     print STDERR "ERROR: backend returned $be_status\n";
 139     $status = 1;
 140 }
 141
 142 $backend->DeleteFile($backend_ior);
 143 $middle->DeleteFile($backend_ior);
 144 $middle->DeleteFile($middle_ior);
 145 $client->DeleteFile($middle_ior);
 146
 147 exit $status;