TAO/tests/Connection_Purging/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 $use_uiop = 0;
  13 $use_shmiop = 0;
  14
  15 foreach $arg (@ARGV) {
  16     if ($arg eq '-debug') {
  17         $debug_level = '10';
  18     }
  19     elsif ($arg eq "-h") {
  20       print "Usage: $0 [-u | -s]\n" .
  21             "       -u for UIOP\n" .
  22             "       -s for SHMIOP\n";
  23       exit(0);
  24     }
  25     elsif ($arg eq "-u") {
  26         $use_uiop = 1;
  27     }
  28     elsif ($arg eq "-s") {
  29         $use_shmiop = 1;
  30     }
  31 }
  32
  33 #constants
  34 my $iorbase = "server.ior";
  35 my $socket_name = "socket";
  36 my $server_count = 20;
  37 my @clients_conf = ("client.lru$PerlACE::svcconf_ext", "client.lfu$PerlACE::svcconf_ext",
  38                     "client.fifo$PerlACE::svcconf_ext", "client.null$PerlACE::svcconf_ext");
  39
  40 #create test targets
  41 my @servers = ();
  42 for($i = 0; $i < $server_count; $i++) {
  43     $servers[$i] = PerlACE::TestTarget::create_target ($i+1) || die "Create target $i+1 failed\n";
  44 }
  45
  46 my @clients = ();
  47 my $clients_count = 0;
  48
  49 $i = 0;
  50 $j = $server_count + 1;
  51 foreach (@clients_conf) {
  52     $clients[$i] = PerlACE::TestTarget::create_target ($j) || die "Create target $j failed\n";
  53     $i++; $j++; $clients_count++;
  54 }
  55
  56 # resources clean
  57 my @servers_iorfile = ();
  58 my @servers_socket = ();
  59 my @servers_endpoint = ();
  60
  61 my @SVS = ();
  62
  63 for($i = 0; $i < $server_count; $i++) {
  64     $servers_iorfile[$i] = $servers[$i]->LocalFile ("$iorbase.$i");
  65     $servers[$i]->DeleteFile("$iorbase.$i");
  66     if ($use_uiop) {
  67         $servers_socket[$i] = $servers[$i]->LocalFile ("$socket_name.$i");
  68         $servers[$i]->DeleteFile("$socket_name.$i");
  69         $servers_endpoint[$i] = "-ORBEndpoint uiop://$servers_socket[$i]";
  70     }
  71     elsif ($use_shmiop) {
  72         $server_conf_base = "server_shmiop$PerlACE::svcconf_ext";
  73         $server_shmiop_conf = $servers[$i]->LocalFile ($server_shmiop_conf);
  74         if ($servers[$i]->PutFile ($server_conf_base) == -1) {
  75             print STDERR "ERROR: cannot set file <$server_shmiop_conf>\n";
  76             exit 1;
  77         }
  78         $servers_endpoint[$i] = "-ORBEndpoint shmiop:// -ORBSvcConf $server_shmiop_conf";
  79     }
  80     else {
  81         $servers_endpoint[$i] = "";
  82     }
  83
  84     $SVS[$i] = $servers[$i]->CreateProcess ("server", "-ORBdebuglevel $debug_level ".
  85                                                  "-o $servers_iorfile[$i] ".
  86                                                  "$servers_endpoint[$i]");
  87
  88     my $server_status = $SVS[$i]->Spawn ();
  89
  90     if ($server_status != 0) {
  91         print STDERR "ERROR: server Spawn $i returned $server_status\n";
  92     }
  93     else {
  94         if ($servers[$i]->WaitForFileTimed ("$iorbase.$i",
  95                                $servers[$i]->ProcessStartWaitInterval()) == -1) {
  96             print STDERR "ERROR: server $i cannot find file <$servers_iorfile[$i]>\n";
  97             $server_status = 1;
  98         }
  99     }
 100
 101     if ($server_status != 0) {
 102         for($j = 0; $j < $i; $j++) {
 103             $SVS[$i]->Kill(); $SVS[$i]->TimedWait(1);
 104         }
 105         exit 1;
 106     }
 107 }
 108
 109 my @clients_iorfile = ();
 110 for($i = 0; $i < $clients_count; $i++) {
 111     $clients_iorfile[$i] = $clients[$i]->LocalFile ($iorbase);
 112     $clients[$i]->DeleteFile($iorbase);
 113 }
 114
 115 my @CLS = ();
 116 for($i = 0; $i < $clients_count; $i++) {
 117     print "========== Client using $clients_conf[$i] configurator file =========\n";
 118     if ($debug_level < 1) {
 119         $debug_level = 1; #min value for debug level is one
 120     }
 121     $client_conf_file = $clients[$i]->LocalFile ($clients_conf[$i]);
 122     if ($clients[$i]->PutFile ($clients_conf[$i]) == -1) {
 123         print STDERR "ERROR: cannot set file <$client_conf_file>\n";
 124     }
 125     $CLS[$i] = $clients[$i]->CreateProcess ("client", "-ORBDebugLevel $debug_level ".
 126                                                       "-k $clients_iorfile[$i] ".
 127                                                       "-ORBSvcConf $client_conf_file");
 128
 129     my $client_status = $CLS[$i]->SpawnWaitKill ($clients[$i]->ProcessStartWaitInterval() + 75);
 130
 131     if ($client_status != 0) {
 132         print STDERR "ERROR: client $i returned $client_status\n";
 133         $status = 1;
 134     }
 135 }
 136
 137 for($i = 0; $i < $server_count; $i++) {
 138     $SVS[$i]->Kill ();
 139     $servers[$i]->DeleteFile("$socket_name.$i");
 140     $servers[$i]->DeleteFile("$iorbase.$i");
 141 }
 142
 143 exit $status;