TAO/tests/POA/TIE/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 = PerlACE::TestTarget::create_target (1) || die "Create target 1 failed\n";
  20 my $client1 = PerlACE::TestTarget::create_target (2) || die "Create target 2 failed\n";
  21 my $client2 = PerlACE::TestTarget::create_target (3) || die "Create target 4 failed\n";
  22
  23 my $iorbase = "ior";
  24
  25 @iors = ($iorbase . "_1",
  26          $iorbase . "_2",
  27          $iorbase . "_3",
  28          $iorbase . "_4",
  29          $iorbase . "_5",
  30          $iorbase . "_6");
  31
  32
  33 my $server_iorfile1 = $server->LocalFile ($iors[0]);
  34 my $server_iorfile2 = $server->LocalFile ($iors[1]);
  35 my $server_iorfile3 = $server->LocalFile ($iors[2]);
  36 my $server_iorfile4 = $server->LocalFile ($iors[3]);
  37 my $server_iorfile5 = $server->LocalFile ($iors[4]);
  38 my $server_iorfile6 = $server->LocalFile ($iors[5]);
  39
  40 my $client1_iorfile1 = $client1->LocalFile ($iors[0]);
  41 my $client1_iorfile2 = $client1->LocalFile ($iors[1]);
  42 my $client1_iorfile3 = $client1->LocalFile ($iors[2]);
  43 my $client1_iorfile4 = $client1->LocalFile ($iors[3]);
  44
  45 my $client2_iorfile5 = $client2->LocalFile ($iors[4]);
  46 my $client2_iorfile6 = $client2->LocalFile ($iors[5]);
  47
  48 # Unlink all ior files
  49 foreach $i (@iors){
  50     $server->DeleteFile ($i);
  51     if ($i == 'ior_5' or $i == 'ior_6'){
  52         $client2->DeleteFile ($i);
  53     }
  54     else{
  55         $client1->DeleteFile ($i);
  56     }
  57 }
  58
  59 $SV = $server->CreateProcess ("server", "-ORBdebuglevel $debug_level " .
  60                               "-a $server_iorfile1 " .
  61                               "-b $server_iorfile2 " .
  62                               "-c $server_iorfile3 " .
  63                               "-d $server_iorfile4 " .
  64                               "-e $server_iorfile5 " .
  65                               "-f $server_iorfile6");
  66
  67 $CL1 = $client1->CreateProcess ("client", "-ORBdebuglevel $debug_level " .
  68                               "-a file://$client1_iorfile1 " .
  69                               "-b file://$client1_iorfile2 " .
  70                               "-c file://$client1_iorfile3 " .
  71                               "-d file://$client1_iorfile4");
  72
  73 $CL2 = $client2->CreateProcess ("client", "-ORBdebuglevel $debug_level " .
  74                               "-e file://$client2_iorfile5 " .
  75                               "-f file://$client2_iorfile6");
  76
  77 $server_status = $SV->Spawn ();
  78
  79 if ($server_status != 0) {
  80     print STDERR "ERROR: server returned $server_status\n";
  81     exit 1;
  82 }
  83
  84 # In this example all the files are written out at the same time. So  make a
  85 # check only for the first file
  86
  87 if ($server->WaitForFileTimed ($iors[5],
  88                                $server->ProcessStartWaitInterval()) == -1) {
  89     print STDERR "ERROR: cannot find file <$server_iorfile6>\n";
  90     $SV->Kill (); $SV->TimedWait (1);
  91     exit 1;
  92 }
  93
  94 foreach $i (@iors){
  95     if ($server->GetFile ($i) == -1) {
  96         print STDERR "ERROR: cannot retrieve file <$i>\n";
  97         $SV->Kill (); $SV->TimedWait (1);
  98         exit 1;
  99     }
 100     if ($i == 'ior_5' or $i == 'ior_6'){
 101         if ($client2->PutFile ($i) == -1) {
 102             print STDERR "ERROR: cannot set file <$i>\n";
 103             $SV->Kill (); $SV->TimedWait (1);
 104             exit 1;
 105         }
 106
 107     }
 108     else{
 109         if ($client1->PutFile ($i) == -1) {
 110             print STDERR "ERROR: cannot set file <$i>\n";
 111             $SV->Kill (); $SV->TimedWait (1);
 112             exit 1;
 113         }
 114     }
 115 }
 116
 117 $client_status = $CL1->SpawnWaitKill ($client1->ProcessStartWaitInterval() + 45);
 118
 119 if ($client_status != 0) {
 120     print STDERR "ERROR: client returned $client_status\n";
 121     $status = 1;
 122 }
 123
 124 $client_status = $CL2->SpawnWaitKill ($client2->ProcessStartWaitInterval() + 45);
 125
 126 if ($client_status != 0) {
 127     print STDERR "ERROR: client returned $client_status\n";
 128     $status = 1;
 129 }
 130
 131 $server_status = $SV->TerminateWaitKill ($server->ProcessStopWaitInterval());
 132
 133 if ($server_status != 0) {
 134     print STDERR "ERROR: server returned $server_status\n";
 135     $status = 1;
 136 }
 137
 138 # Unlink all ior files
 139 foreach $i (@iors){
 140     $server->DeleteFile ($i);
 141     if ($i == 'ior_5' or $i == 'ior_6'){
 142         $client2->DeleteFile ($i);
 143     }
 144     else{
 145         $client1->DeleteFile ($i);
 146     }
 147 }
 148
 149 exit $status;