TAO/tests/Big_Request_Muxing/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 3 failed\n";
  22
  23 my $iorbase = "server.ior";
  24 my $expected = 400;
  25 my $maybe_lost = 800;
  26 my $server_iorfile = $server->LocalFile ($iorbase);
  27 my $client1_iorfile = $client1->LocalFile ($iorbase);
  28 my $client2_iorfile = $client2->LocalFile ($iorbase);
  29 $server->DeleteFile($iorbase);
  30 $client1->DeleteFile($iorbase);
  31 $client2->DeleteFile($iorbase);
  32
  33 $SV = $server->CreateProcess ("server", "-ORBdebuglevel $debug_level -o $server_iorfile ".
  34                                         "-e $expected -l $maybe_lost");
  35 $CL1 = $client1->CreateProcess ("client", "-k file://$client1_iorfile");
  36 $CL2 = $client2->CreateProcess ("client", "-k file://$client2_iorfile");
  37
  38 # -*- perl -*-
  39
  40 for ($n = 0; $n < 10; ++$n) {
  41     print "=================================================================\n";
  42
  43     $server->DeleteFile($iorbase);
  44     $client1->DeleteFile($iorbase);
  45     $client2->DeleteFile($iorbase);
  46
  47     $server_status = $SV->Spawn ();
  48     if ($server_status != 0) {
  49         print STDERR "ERROR: server returned $server_status\n";
  50         exit 1;
  51     }
  52
  53     if ($server->WaitForFileTimed ($iorbase,
  54                                    $server->ProcessStartWaitInterval()) == -1) {
  55         print STDERR "ERROR: cannot find file <$server_iorfile>\n";
  56         $SV->Kill (); $SV->TimedWait (1);
  57         exit 1;
  58     }
  59
  60     if ($server->GetFile ($iorbase) == -1) {
  61         print STDERR "ERROR: cannot retrieve file <$server_iorfile>\n";
  62         $SV->Kill (); $SV->TimedWait (1);
  63         exit 1;
  64     }
  65
  66     if ($client1->PutFile ($iorbase) == -1) {
  67         print STDERR "ERROR: cannot set file <$client1_iorfile>\n";
  68         $SV->Kill (); $SV->TimedWait (1);
  69         exit 1;
  70     }
  71
  72     if ($client2->PutFile ($iorbase) == -1) {
  73         print STDERR "ERROR: cannot set file <$client2_iorfile>\n";
  74         $SV->Kill (); $SV->TimedWait (1);
  75         exit 1;
  76     }
  77
  78     $client1_status = $CL1->Spawn ();
  79
  80     if ($client1_status != 0) {
  81         print STDERR "ERROR: client 1 returned $client1_status\n";
  82         $SV->Kill();
  83         exit 1;
  84     }
  85
  86     $client2_status = $CL2->Spawn ();
  87
  88     if ($client2_status != 0) {
  89         print STDERR "ERROR: client 2 returned $client2_status\n";
  90         $CL1->Kill();
  91         $SV->Kill();
  92         exit 1;
  93     }
  94
  95     $client_status = $CL1->WaitKill ($client1->ProcessStartWaitInterval() + 25);
  96     if ($client_status != 0) {
  97         print STDERR "ERROR: client 1 returned $client_status\n";
  98         $CL2->Kill();
  99         $SV->Kill();
 100         exit 1;
 101     }
 102
 103     $client_status = $CL2->WaitKill ($client2->ProcessStartWaitInterval() + 25);
 104     if ($client_status != 0) {
 105         print STDERR "ERROR: client 2 returned $client_status\n";
 106         $SV->Kill();
 107         exit 1;
 108     }
 109
 110     $server_status = $SV->WaitKill ($server->ProcessStopWaitInterval() + 45);
 111
 112     if ($server_status != 0) {
 113         print STDERR "ERROR: server returned $server_status\n";
 114         $status = 1;
 115     }
 116 }
 117
 118 $server->DeleteFile($iorbase);
 119 $client1->DeleteFile($iorbase);
 120 $client2->DeleteFile($iorbase);
 121
 122 exit $status;