TAO/tests/Bug_3531_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 POSIX "sys_wait_h";
  10
  11 $status = 0;
  12 $debug_level = '0';
  13
  14 foreach $i (@ARGV) {
  15     if ($i eq '-debug') {
  16         $debug_level = '10';
  17     }
  18 }
  19
  20 # constants
  21 my $verbose = 1;
  22 my $server_threads = 2;
  23 my $num_clients = 5;
  24 my $iorbase = "server.ior";
  25 my $shutdown = "server_terminated";
  26
  27 # create test targets
  28 my $server = PerlACE::TestTarget::create_target (1) || die "Create target 1 failed\n";
  29 my @clients = ();
  30 for($i = 0; $i < $num_clients; $i++) {
  31     $clients[$i] = PerlACE::TestTarget::create_target ($i+1) || die "Create target $i+1 failed\n";
  32 }
  33
  34 # clean resources before start
  35 my $server_iorfile = $server->LocalFile ($iorbase);
  36 my $server_shutdownfile = $server->LocalFile ($shutdown);
  37 $server->DeleteFile($iorbase);
  38 $server->DeleteFile($shutdown);
  39 my @clients_iorfile = ();
  40 for($i = 0; $i < $num_clients; $i++) {
  41     $clients_iorfile[$i] = $clients[$i]->LocalFile ($iorbase);
  42     $clients[$i]->DeleteFile ($iorbase);
  43 }
  44
  45 # create processes
  46 $SV = $server->CreateProcess ("server", "-ORBdebuglevel $debug_level ".
  47                                         "-o $server_iorfile -n $server_threads ".
  48                                         "-x $server_shutdownfile");
  49
  50 my @CLS = ();
  51 for($i = 0; $i < $num_clients - 1; $i++) {
  52     $CLS[$i] = $clients[$i]->CreateProcess ("client", "-k file://$clients_iorfile[$i]");
  53 }
  54 $CLS[$num_clients - 1] = $clients[$i]->CreateProcess ("client",
  55                                     "-k file://$clients_iorfile[$num_clients - 1] -x");
  56
  57 # start server and wait for file
  58 $server_status = $SV->Spawn ();
  59
  60 if ($server_status != 0) {
  61     print STDERR "ERROR: server returned $server_status\n";
  62     exit 1;
  63 }
  64
  65 if ($server->WaitForFileTimed ($iorbase,
  66                                $server->ProcessStartWaitInterval()) == -1) {
  67     print STDERR "ERROR: cannot find file <$server_iorfile>\n";
  68     $SV->Kill (); $SV->TimedWait (1);
  69     exit 1;
  70 }
  71
  72 # deliver ior file to all consumers
  73 if ($server->GetFile ($iorbase) == -1) {
  74     print STDERR "ERROR: cannot retrieve file <$server_iorfile>\n";
  75     $SV->Kill (); $SV->TimedWait (1);
  76     exit 1;
  77 }
  78
  79 for($i = 0; $i < $num_clients; $i++) {
  80     if ($clients[$i]->PutFile ($iorbase) == -1) {
  81         print STDERR "ERROR: client $i cannot set file <$clients_iorfile[$i]>\n";
  82         $status = 1; $i = $num_clients;
  83     }
  84 }
  85
  86 if ($status != 0) {
  87     $SV->Kill (); $SV->TimedWait (1);
  88     exit $status;
  89 }
  90
  91 # spawn clients in the loop and one in separated way
  92 my $broken_number = 0;
  93 for($i = 0; $i < $num_clients - 1; $i++) {
  94     my $client_status = $CLS[$i]->Spawn();
  95     if ($client_status != 0) {
  96         print STDERR "ERROR: client $i Spawn returned $client_status\n";
  97         $broken_number = $i; $i = $num_clients;  $status = 1;
  98     }
  99 }
 100
 101 if ($status != 0) {
 102     for($i = 0; $i < $broken_number; $i++) {
 103         $CLS[$i]->Kill (); $CLS[$i]->TimedWait (1);
 104     }
 105
 106     $SV->Kill (); $SV->TimedWait (1);
 107     exit $status;
 108 }
 109
 110 for($i = 0; $i < $num_clients - 1; $i++) {
 111     my $client_status = $CLS[$i]->WaitKill ($clients[$i]->ProcessStartWaitInterval());
 112     if ($client_status != 0) {
 113         print STDERR "ERROR: client $i WaitKill returned $client_status\n";
 114         $broken_number = $i; $i = $num_clients; $status = 1;
 115     }
 116 }
 117
 118 if ($status != 0) {
 119     for($i = $broken_number; $i < $num_clients - 1; $i++) {
 120         $CLS[$i]->Kill (); $CLS[$i]->TimedWait (1);
 121     }
 122
 123     $SV->Kill (); $SV->TimedWait (1);
 124     exit $status;
 125 }
 126
 127 #Server should still be running at this point, now start the client that asks
 128 #the server to shut itself down
 129
 130 $client_status = $CLS[$num_clients - 1]->SpawnWaitKill ($clients[$num_clients - 1]->ProcessStartWaitInterval());
 131
 132 if ($client_status != 0) {
 133     print STDERR "ERROR: client $num_clients - 1 returned $client_status\n";
 134     $status = 1;
 135 }
 136
 137 #Server should now be shutdown
 138 if ($server->WaitForFileTimed ($shutdown,
 139                                $server->ProcessStartWaitInterval()) == -1) {
 140     print STDERR "ERROR: cannot find file <$server_shutdownfile>\n";
 141     $SV->Kill (); $SV->TimedWait (1);
 142     exit 1;
 143 }
 144
 145 $server_status = $SV->WaitKill ($server->ProcessStopWaitInterval());
 146
 147 if ($server_status != 0) {
 148     print STDERR "ERROR: server returned $server_status\n";
 149     $status = 1;
 150 }
 151
 152 $server->DeleteFile($iorbase);
 153 $server->DeleteFile($shutdown);
 154 for($i = 0; $i < $num_clients; $i++) {
 155     $clients[$i]->DeleteFile ($iorbase);
 156 }
 157
 158 exit $status;