TAO/examples/CSD_Strategy/ThreadPool/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 $num_clients = 40;
  13
  14 foreach $i (@ARGV) {
  15     if ($i eq '-debug') {
  16         $debug_level = '10';
  17     }
  18 }
  19
  20 my $server = PerlACE::TestTarget::create_target (1) || die "Create target 1 failed\n";
  21 my @clients = ();
  22 for ($i = 0; $i < $num_clients; $i++) {
  23     $clients[$i] = PerlACE::TestTarget::create_target ($i+1) || die "Create target $i+1 failed\n";
  24 }
  25
  26 my $iorbase = "server.ior";
  27
  28 my $server_iorfile = $server->LocalFile ($iorbase);
  29 $server->DeleteFile($iorbase);
  30 $SV = $server->CreateProcess ("server_main", "-ORBdebuglevel $debug_level ".
  31                                              "-o $server_iorfile -n $num_clients");
  32
  33 my @CLS = ();
  34 my @clients_iorfile = ();
  35 for ($i = 0; $i < $num_clients; $i++) {
  36     $clients_iorfile[$i] = $clients[$i]->LocalFile ($iorbase);
  37     $clients[$i]->DeleteFile($iorbase);
  38     $CLS[$i] = $clients[$i]->CreateProcess ("client_main", "-i file://$clients_iorfile[$i]");
  39 }
  40
  41 $server_status = $SV->Spawn ();
  42
  43 if ($server_status != 0) {
  44     print STDERR "ERROR: server returned $server_status\n";
  45     exit 1;
  46 }
  47
  48 if ($server->WaitForFileTimed ($iorbase,
  49                                $server->ProcessStartWaitInterval()) == -1) {
  50     print STDERR "ERROR: cannot find file <$server_iorfile>\n";
  51     $SV->Kill (); $SV->TimedWait (1);
  52     exit 1;
  53 }
  54
  55 if ($server->GetFile ($iorbase) == -1) {
  56     print STDERR "ERROR: cannot retrieve file <$server_iorfile>\n";
  57     $SV->Kill (); $SV->TimedWait (1);
  58     exit 1;
  59 }
  60
  61 for ($i = 0; $i < $num_clients; $i++) {
  62     if ($clients[$i]->PutFile ($iorbase) == -1) {
  63         print STDERR "ERROR: client $i cannot set file <$clients_iorfile[$i]>\n";
  64         $SV->Kill (); $SV->TimedWait (1);
  65         exit 1;
  66     }
  67 }
  68
  69 for ($i = 0; $i < $num_clients; $i++) {
  70     my $client_status = $CLS[$i]->Spawn();
  71     if ($client_status != 0) {
  72         print STDERR "ERROR: client $i Spawn returned $client_status\n";
  73         $status = 1;
  74     }
  75 }
  76
  77 for ($i = 0; $i < $num_clients; $i++) {
  78     my $client_status = $CLS[$i]->WaitKill ($clients[$i]->ProcessStartWaitInterval() + 45);
  79
  80     if ($client_status != 0) {
  81         print STDERR "ERROR: client returned $client_status\n";
  82         $status = 1;
  83     }
  84 }
  85
  86 $server_status = $SV->WaitKill ($server->ProcessStopWaitInterval() + 45);
  87
  88 if ($server_status != 0) {
  89     print STDERR "ERROR: server returned $server_status\n";
  90     $status = 1;
  91 }
  92
  93 $server->DeleteFile($iorbase);
  94 for ($i = 0; $i < $num_clients; $i++) {
  95     $clients[$i]->DeleteFile($iorbase);
  96 }
  97
  98 exit $status;