TAO/tests/HandleExhaustion/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 strict;
  10
  11 if ($^O eq 'lynxos') {
  12     print "This test will not run properly on LynxOS.\n",
  13         "When one process uses up all of the file descriptors, no other\n",
  14         "processes run by the same user can start.\n";
  15     exit(0);
  16 }
  17
  18 my $status = 0;
  19
  20 my $server = PerlACE::TestTarget::create_target (1) || die "Create target 1 failed\n";
  21 my $client = PerlACE::TestTarget::create_target (2) || die "Create target 2 failed\n";
  22
  23 $server->AddRuntimeLibrary ('TAO_Codeset');
  24
  25 my $iorbase = "server.ior";
  26 my $server_iorfile = $server->LocalFile ($iorbase);
  27 my $client_iorfile = $client->LocalFile ($iorbase);
  28 $server->DeleteFile($iorbase);
  29 $client->DeleteFile($iorbase);
  30
  31 my $logbase = 'server.log';
  32 my $server_logfile = $server->LocalFile ($logbase);
  33 $server->DeleteFile($logbase);
  34
  35 my $SV = $server->CreateProcess ("server", "-ORBAcceptErrorDelay 5 -ORBDebugLevel 1 -ORBLogFile $server_logfile -o $server_iorfile");
  36 my $CL = $client->CreateProcess ("client", "-k file://$client_iorfile");
  37
  38 my $server_status = $SV->Spawn();
  39
  40 if ($server_status != 0) {
  41     print STDERR "ERROR: server returned $server_status\n";
  42     exit 1;
  43 }
  44
  45 if ($server->WaitForFileTimed ($iorbase,
  46                                $server->ProcessStartWaitInterval()) == -1) {
  47     print STDERR "ERROR: cannot find file <$server_iorfile>\n";
  48     $SV->Kill (); $SV->TimedWait (1);
  49     exit 1;
  50 }
  51
  52 my $client_status = $CL->SpawnWaitKill(10 + $client->ProcessStartWaitInterval ());
  53
  54 if ($client_status != 0) {
  55     print STDERR "ERROR: client returned $client_status\n";
  56     $status = 1;
  57 }
  58
  59 $server_status = $SV->WaitKill($server->ProcessStopWaitInterval ());
  60
  61 if ($server_status != 0) {
  62     print STDERR "ERROR: server returned $server_status\n";
  63     $status = 1;
  64 }
  65
  66 if ($server->GetFile ($logbase) == -1) {
  67     print STDERR "ERROR: cannot retrieve file <$server_logfile>\n";
  68     exit 1;
  69 }
  70
  71 #if ($status == 0) {
  72     if (open(FH, $server_logfile)) {
  73         my $error_achieved = 0;
  74         my $reregister = 0;
  75         print STDERR "processing <$server_logfile>\n";
  76         while(<FH>) {
  77             print STDERR $_;
  78             if (/TAO_Acceptor::handle_accept_error.+Too many files open/) {
  79                 ++$error_achieved;
  80             }
  81             elsif (/TAO_Acceptor::handle_expiration.+registering\s+the\s+acceptor/) {
  82                 ++$reregister;
  83             }
  84         }
  85         close(FH);
  86
  87         if (!$error_achieved) {
  88             print STDERR "ERROR: The error situation was not achieved\n";
  89             ++$status;
  90         }
  91         if (!$reregister) {
  92             print STDERR "ERROR: The acceptor was not reregistered\n";
  93             ++$status;
  94         }
  95     }
  96     else {
  97         print STDERR "ERROR: Unable to read $server_logfile\n";
  98         ++$status;
  99     }
 100 #}
 101
 102 $server->DeleteFile($iorbase);
 103 $client->DeleteFile($iorbase);
 104 $server->DeleteFile($logbase);
 105
 106 exit($status);