TAO/tests/Portable_Interceptors/Bug_3079/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
   8
   9 use lib "$ENV{ACE_ROOT}/bin";
  10 use PerlACE::TestTarget;
  11
  12 my $server1 = PerlACE::TestTarget::create_target (1) || die "Create target 1 failed\n";
  13 my $server2 = PerlACE::TestTarget::create_target (2) || die "Create target 2 failed\n";
  14 my $server3 = PerlACE::TestTarget::create_target (3) || die "Create target 3 failed\n";
  15 my $client  = PerlACE::TestTarget::create_target (4) || die "Create target 4 failed\n";
  16
  17 my $iorbase1 = "test1.ior";
  18 my $iorbase2 = "test2.ior";
  19 my $iorbase3 = "test3.ior";
  20
  21 my $server1_iorfile = $server1->LocalFile ($iorbase1);
  22 my $server2_iorfile = $server2->LocalFile ($iorbase2);
  23 my $server3_iorfile = $server3->LocalFile ($iorbase3);
  24 my $client_iorfile1 = $client->LocalFile ($iorbase1);
  25 my $client_iorfile2 = $client->LocalFile ($iorbase2);
  26 my $client_iorfile3 = $client->LocalFile ($iorbase3);
  27
  28 $server1->DeleteFile ($iorbase1);
  29 $server2->DeleteFile ($iorbase2);
  30 $server3->DeleteFile ($iorbase3);
  31 $client->DeleteFile ($iorbase1);
  32 $client->DeleteFile ($iorbase2);
  33 $client->DeleteFile ($iorbase3);
  34
  35 $SV1 = $server1->CreateProcess ("server", "-o $server1_iorfile -c 1 -n 1 -s 1");
  36 $SV2 = $server2->CreateProcess ("server", "-o $server2_iorfile -n 2 -s 2");
  37 $SV3 = $server3->CreateProcess ("server", "-o $server3_iorfile -n 3 -s 3");
  38 $CL  = $client->CreateProcess ("client",
  39                     "-p file://$client_iorfile1 -f file://$client_iorfile2 -s file://$client_iorfile3");
  40
  41 $status = 0;
  42
  43 print STDERR "\n\n==== Running PortableInterceptor::Bug_3079 test\n";
  44
  45 $SV1->Spawn ();
  46 $SV2->Spawn ();
  47 $SV3->Spawn ();
  48
  49 if ($server1->WaitForFileTimed ($iorbase1,
  50                                $server1->ProcessStartWaitInterval()) == -1) {
  51     print STDERR "ERROR: cannot find file <$server1_iorfile>\n";
  52     $SV1->Kill (); $SV1->TimedWait (1);
  53     exit 1;
  54 }
  55
  56 if ($server2->WaitForFileTimed ($iorbase2,
  57                                $server2->ProcessStartWaitInterval()) == -1) {
  58     print STDERR "ERROR: cannot find file <$server2_iorfile>\n";
  59     $SV1->Kill (); $SV1->TimedWait (1);
  60     $SV2->Kill (); $SV2->TimedWait (1);
  61     exit 1;
  62 }
  63
  64 if ($server3->WaitForFileTimed ($iorbase3,
  65                                $server3->ProcessStartWaitInterval()) == -1) {
  66     print STDERR "ERROR: cannot find file <$server3_iorfile>\n";
  67     $SV1->Kill (); $SV1->TimedWait (1);
  68     $SV2->Kill (); $SV2->TimedWait (1);
  69     $SV3->Kill (); $SV3->TimedWait (1);
  70     exit 1;
  71 }
  72
  73 $client_status = $CL->SpawnWaitKill ($client->ProcessStartWaitInterval());
  74
  75 if ($client_status != 0) {
  76     print STDERR "ERROR: client returned $client_status\n";
  77     $status = 1;
  78 }
  79
  80 $server1_status = $SV1->WaitKill ($server1->ProcessStopWaitInterval());
  81
  82 # The first server will crash by design and in such instance it will
  83 # return the magic number 1. The test must not interpret it as an
  84 # error.
  85
  86 if ($server1_status != 0) {
  87     if ($server1_status != 1) {
  88         print STDERR "ERROR: server1 returned $server1_status\n";
  89         $status = 1;
  90     }
  91     else {
  92         print STDERR "INFO: server1 commited suicide as expected\n";
  93     }
  94 }
  95
  96 $server2_status = $SV2->WaitKill ($server2->ProcessStopWaitInterval());
  97
  98 # The second server will crash by design and in such instance it will
  99 # return the magic number 1. The test must not interpret it as an
 100 # error.
 101 if ($server2_status != 0) {
 102     if ($server2_status != 1) {
 103         print STDERR "ERROR: server2 returned $server2_status\n";
 104         $status = 1;
 105     }
 106     else {
 107         print STDERR "INFO: server2 commited suicide as expected\n";
 108     }
 109 }
 110
 111 $server3_status = $SV3->WaitKill ($server3->ProcessStopWaitInterval());
 112
 113 if ($server3_status != 0) {
 114     print STDERR "ERROR: server3 returned $server3_status\n";
 115     $status = 1;
 116 }
 117
 118 $server1->DeleteFile ($iorbase1);
 119 $server2->DeleteFile ($iorbase2);
 120 $server3->DeleteFile ($iorbase3);
 121 $client->DeleteFile ($iorbase1);
 122 $client->DeleteFile ($iorbase2);
 123 $client->DeleteFile ($iorbase3);
 124
 125 exit $status;