TAO/tests/Bug_1361_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
  13 $debug_opts = '';
  14 $srv_debug = '';
  15 foreach $i (@ARGV) {
  16     if ($i eq '-debug') {
  17         $debug_opts = '-ORBDebugLevel 10 -ORBVerboseLogging 1 '
  18                     . '-ORBLogFile client';
  19         $srv_debug  = '-ORBDebugLevel 5';
  20     }
  21 }
  22
  23 my $server = PerlACE::TestTarget::create_target (1) || die "Create target 1 failed\n";
  24 my $client = PerlACE::TestTarget::create_target (2) || die "Create target 2 failed\n";
  25 my $shutdown = PerlACE::TestTarget::create_target (3) || die "Create target 3 failed\n";
  26
  27 my $iorbase = "server.ior";
  28 my $server_iorfile = $server->LocalFile ($iorbase);
  29 my $client_iorfile = $client->LocalFile ($iorbase);
  30 my $shutdown_iorfile = $shutdown->LocalFile ($iorbase);
  31 $server->DeleteFile($iorbase);
  32 $client->DeleteFile($iorbase);
  33 $shutdown->DeleteFile ($iorbase);
  34
  35 $SV = $server->CreateProcess ("server", "-o $server_iorfile $srv_debug");
  36 my $threads = int (rand() * 6) + 1;
  37 $CL = $client->CreateProcess ("client", "-k file://$client_iorfile -t $threads $debug_opts");
  38 $SH = $shutdown->CreateProcess ("shutdown", "-k file://$shutdown_iorfile");
  39
  40 $server_status = $SV->Spawn ();
  41
  42 if ($server_status != 0) {
  43     print STDERR "ERROR: server returned $server_status\n";
  44     exit 1;
  45 }
  46
  47 if ($server->WaitForFileTimed ($iorbase,
  48                                $server->ProcessStartWaitInterval()) == -1) {
  49     print STDERR "ERROR: cannot find file <$server_iorfile>\n";
  50     $SV->Kill (); $SV->TimedWait (1);
  51     exit 1;
  52 }
  53
  54 if ($server->GetFile ($iorbase) == -1) {
  55     print STDERR "ERROR: cannot retrieve file <$server_iorfile>\n";
  56     $SV->Kill (); $SV->TimedWait (1);
  57     exit 1;
  58 }
  59
  60 if ($client->PutFile ($iorbase) == -1) {
  61     print STDERR "ERROR: cannot set file <$client_iorfile>\n";
  62     $SV->Kill (); $SV->TimedWait (1);
  63     exit 1;
  64 }
  65
  66 local $start_time = time();
  67 local $max_running_time = 720;
  68 local $elapsed = time() - $start_time;
  69
  70 if ($ARGV[0] eq '-quick')  {
  71     $elapsed = 0;
  72     $max_running_time = 1;
  73 }
  74
  75 my $client_idx = 0;
  76 while (($elapsed < $max_running_time)) {
  77     # Start all clients in parallel
  78     my $args_saved = $CL->Arguments ();
  79     $CL->Arguments ("$args_saved$client_idx.log") unless $debug_opts eq '';
  80     my $client_status = $CL->Spawn ();
  81     if ($client_status != 0) {
  82         print STDERR "ERROR: client returned $client_status\n";
  83         $status = 1;
  84     }
  85
  86     if ($debug_opts ne '') {
  87         $CL->Arguments ($args_saved);
  88         print "Spawned client $client_idx\n";
  89         ++$client_idx;
  90     }
  91
  92     if ($client_status == 0) {
  93         $CL->WaitKill($client->ProcessStartWaitInterval() + 75, {self_crash => 1});
  94         if ($client_status != 0) {
  95             print STDERR "ERROR: client returned $client_status\n";
  96             $status = 1;
  97         }
  98     }
  99
 100     print STDERR "checking server alive\n";
 101
 102     my $res = $SV->Wait(1);
 103
 104     if ($res != -1) {
 105         $server_died = 1;
 106         last;
 107     }
 108
 109     $elapsed = time() - $start_time;
 110 }
 111
 112 if (!$server_died) {
 113     my $shutdown_status = $SH->SpawnWaitKill($shutdown->ProcessStartWaitInterval());
 114     if ($shutdown_status != 0) {
 115         print STDERR "ERROR: shutdown returned $$shutdown_status\n";
 116         $status = 1;
 117     }
 118
 119     $server_status = $SV->WaitKill ($server->ProcessStopWaitInterval() + 300);
 120     if ($server_status != 0) {
 121         print STDERR "ERROR: server returned $server_status\n";
 122         $status = 1;
 123     }
 124 }
 125
 126 $server->DeleteFile($iorbase);
 127 $client->DeleteFile($iorbase);
 128 $shutdown->DeleteFile ($iorbase);
 129
 130 exit $status;