TAO/tests/Server_Leaks/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 Getopt::Std;
  10
  11 $status = 0;
  12
  13 #get incoming arguments
  14 $debug_level = '0';
  15
  16 foreach $i (@ARGV) {
  17     if ($i eq '-debug') {
  18         $debug_level = '10';
  19     }
  20 }
  21
  22 local ($opt_i);
  23
  24 if (!getopts ('i:')) {
  25     print "Usage: run_test.pl [-i iterations]\n";
  26     exit 1;
  27 }
  28
  29 my $iorbase = "server.ior";
  30 my $concurrent_clients = 30;
  31 my $iterations = 40;
  32
  33 if (defined $opt_i) {
  34     $iterations = $opt_i;
  35 }
  36
  37 my $server = PerlACE::TestTarget::create_target (1) || die "Create target 1 failed\n";
  38 my @clients = ();
  39 for ($i = 0; $i < $concurrent_clients + 1; $i++) {
  40     $clients[$i] = PerlACE::TestTarget::create_target ($i+1) || die "Create target $i+1 failed\n";
  41 }
  42
  43
  44 my $server_iorfile = $server->LocalFile ($iorbase);
  45 $server->DeleteFile($iorbase);
  46 $SV = $server->CreateProcess ("server", "-ORBdebuglevel $debug_level -o $server_iorfile");
  47
  48 my @CLS = ();
  49 my @clients_iorfile = ();
  50 for ($i = 0; $i < $concurrent_clients + 1; $i++) {
  51     $clients_iorfile[$i] = $clients[$i]->LocalFile ($iorbase);
  52     $clients[$i]->DeleteFile ($iorbase);
  53     $CLS[$i] = $clients[$i]->CreateProcess ("client", "-k file://$clients_iorfile[$i]");
  54 }
  55
  56 $server_status = $SV->Spawn ();
  57
  58 if ($server_status != 0) {
  59     print STDERR "ERROR: server returned $server_status\n";
  60     exit 1;
  61 }
  62
  63 if ($server->WaitForFileTimed ($iorbase,
  64                                $server->ProcessStartWaitInterval()) == -1) {
  65     print STDERR "ERROR: cannot find file <$server_iorfile>\n";
  66     $SV->Kill (); $SV->TimedWait (1);
  67     exit 1;
  68 }
  69
  70 if ($server->GetFile ($iorbase) == -1) {
  71     print STDERR "ERROR: cannot retrieve file <$server_iorfile>\n";
  72     $SV->Kill (); $SV->TimedWait (1);
  73     exit 1;
  74 }
  75
  76 for ($i = 0; $i < $concurrent_clients + 1; $i++) {
  77     if ($clients[$i]->PutFile ($iorbase) == -1) {
  78         print STDERR "ERROR: client $i cannot set file <$clients_iorfile[$i]>\n";
  79         $SV->Kill (); $SV->TimedWait (1);
  80         exit 1;
  81     }
  82 }
  83
  84 $count = 0;
  85 for ($i = 0; $i != $iterations; $i++) {
  86     # First spawn all the processes
  87     for ($j = 0; $j < $concurrent_clients; $j++) {
  88         $CLS[$j]->Spawn ();
  89         $count++;
  90     }
  91     # Now wait for each one
  92     for ($j = 0; $j < $concurrent_clients; $j++) {
  93         my $client_status = $CLS[$j]->WaitKill ($clients[$j]->ProcessStartWaitInterval());
  94         if ($client_status != 0) {
  95             print STDERR "ERROR: client $j returned $client_status in iteration $i\n";
  96             $status = 1;
  97         }
  98     }
  99     if ($count % 100 == 0) {
 100         print STDERR "Iteration $i has created $count clients\n";
 101     }
 102 }
 103
 104
 105 my $CL = $clients[$concurrent_clients]->CreateProcess ("client",
 106                          "-k file://$clients_iorfile[$concurrent_clients] -x");
 107 my $client_status = $CL->SpawnWaitKill ($clients[$concurrent_clients]->ProcessStartWaitInterval());
 108
 109 if ($client_status != 0) {
 110     print STDERR "ERROR: client $concurrent_clients returned $client_status during test shutdown\n";
 111     $status = 1;
 112 }
 113
 114 $server_status = $SV->WaitKill ($server->ProcessStopWaitInterval());
 115
 116 if ($server_status != 0) {
 117     print STDERR "ERROR: server returned $server_status\n";
 118     $status = 1;
 119 }
 120
 121 $server->DeleteFile($iorbase);
 122 for ($i = 0; $i < $concurrent_clients + 1; $i++) {
 123     $clients[$i]->DeleteFile ($iorbase);
 124 }
 125
 126 exit $status;