TAO/tests/Muxed_GIOP_Versions/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
  12 my $server = PerlACE::TestTarget::create_target (1) || die "Create target 1 failed\n";
  13 my $client1 = PerlACE::TestTarget::create_target (2) || die "Create target 2 failed\n";
  14 my $client2 = PerlACE::TestTarget::create_target (3) || die "Create target 3 failed\n";
  15 my $client3 = PerlACE::TestTarget::create_target (4) || die "Create target 4 failed\n";
  16
  17 my $TARGETHOSTNAME = $server->HostName ();
  18 my $port = $server->RandomPort ();
  19
  20 my $iorbase = "server.ior";
  21 my $logbase = "orb.$port.log";
  22 my $server_iorfile = $server->LocalFile ($iorbase);
  23 my $server_logfile = $server->LocalFile ($logbase);
  24 my $client1_iorfile = $client1->LocalFile ($iorbase);
  25 my $client1_logfile = $client1->LocalFile ($logbase);
  26 my $client2_iorfile = $client2->LocalFile ($iorbase);
  27 my $client2_logfile = $client2->LocalFile ($logbase);
  28 my $client3_iorfile = $client3->LocalFile ($iorbase);
  29 my $client3_logfile = $client3->LocalFile ($logbase);
  30 $server->DeleteFile($iorbase);
  31 $server->DeleteFile($logbase);
  32 $client1->DeleteFile($iorbase);
  33 $client1->DeleteFile($logbase);
  34 $client2->DeleteFile($iorbase);
  35 $client2->DeleteFile($logbase);
  36 $client3->DeleteFile($iorbase);
  37 $client3->DeleteFile($logbase);
  38
  39 # Testing Options:
  40 # most effective is $serveriterations=1000 (with or without clients)
  41 my $verbose = 1;
  42 my $serverthreads = '10';
  43 my $selfabusethreads = '5';
  44 my $clientthreads = '5';
  45 my $serveriterations = 1000;
  46 my $clientiterations = 1000;
  47 my $clients = 1;
  48
  49 # use GIOP 1.0
  50 my $corbaloc_str = "corbaloc:iiop:1.0\@$TARGETHOSTNAME:$port/".
  51     "SomeObjectNameThatDontExist";
  52
  53 # -ORBDebugLevel 10 seems to encourage the problem
  54 # -ORBCollocation no is required for server to produce the problem
  55
  56 $SV = $server->CreateProcess ("server",
  57                               "-ORBCollocation no -ORBdebuglevel 10 ".
  58                               "-ORBLogFile $server_logfile ".
  59                               "-ORBListenEndpoints iiop://$TARGETHOSTNAME:$port ".
  60                               "-i $serveriterations -n $serverthreads ".
  61                               "-c $selfabusethreads -l $corbaloc_str ".
  62                               "-o $server_iorfile");
  63 $CL1 = $client1->CreateProcess ("client",
  64                                 "-ORBdebuglevel 10 -ORBLogFile $client1_logfile ".
  65                                 "-l $corbaloc_str -k file://$client1_iorfile ".
  66                                 "-n $clientthreads -i $clientiterations");
  67 $CL2 = $client2->CreateProcess ("client",
  68                                 "-ORBdebuglevel 10 -ORBLogFile $client2_logfile ".
  69                                 "-l $corbaloc_str -k file://$client2_iorfile ".
  70                                 "-n $clientthreads -i $clientiterations");
  71 $CL3 = $client3->CreateProcess ("client",
  72                                 "-ORBdebuglevel 10 -ORBLogFile $client3_logfile ".
  73                                 "-l $corbaloc_str -k file://$client3_iorfile ".
  74                                 "-n $clientthreads -i $clientiterations");
  75
  76 print STDERR "***** Start the server*** \n" if $verbose;
  77
  78 $server_status = $SV->Spawn ();
  79
  80 if ($server_status != 0) {
  81     print STDERR "ERROR: server returned $server_status\n";
  82     exit 1;
  83 }
  84
  85 if ($server->WaitForFileTimed ($iorbase,
  86                                $server->ProcessStartWaitInterval()) == -1) {
  87     print STDERR "ERROR: cannot find file <$server_iorfile>\n";
  88     $SV->Kill (); $SV->TimedWait (1);
  89     exit 1;
  90 }
  91
  92 # leave server reap some self abuse before clients start abusing it
  93 if ($serveriterations > 20) {
  94     $SV->TimedWait(10);
  95 }
  96
  97 if ($server->GetFile ($iorbase) == -1) {
  98     print STDERR "ERROR: cannot retrieve file <$server_iorfile>\n";
  99     $SV->Kill (); $SV->TimedWait (1);
 100     exit 1;
 101 }
 102 if ($client1->PutFile ($iorbase) == -1) {
 103     print STDERR "ERROR: cannot set file <$client1_iorfile>\n";
 104     $SV->Kill (); $SV->TimedWait (1);
 105     exit 1;
 106 }
 107 if ($client2->PutFile ($iorbase) == -1) {
 108     print STDERR "ERROR: cannot set file <$client2_iorfile>\n";
 109     $SV->Kill (); $SV->TimedWait (1);
 110     exit 1;
 111 }
 112 if ($client3->PutFile ($iorbase) == -1) {
 113     print STDERR "ERROR: cannot set file <$client3_iorfile>\n";
 114     $SV->Kill (); $SV->TimedWait (1);
 115     exit 1;
 116 }
 117
 118 print STDERR "****** Start the clients*** \n" if $verbose;
 119
 120 if ($clients > 0) {
 121     $client_status = $CL1->Spawn ();
 122
 123     if ($client_status != 0) {
 124         print STDERR "ERROR: client returned $client_status\n";
 125         $SV->Kill (); $SV->TimedWait (1);
 126         exit 1;
 127     }
 128 }
 129
 130 if ($clients > 1) {
 131     $client_status = $CL2->Spawn ();
 132
 133     if ($client_status != 0) {
 134         print STDERR "ERROR: client returned $client_status\n";
 135         $SV->Kill (); $SV->TimedWait (1);
 136         $CL1->Kill (); $CL1->TimedWait (1);
 137         exit 1;
 138     }
 139 }
 140
 141 if ($clients > 2) {
 142     $client_status = $CL3->Spawn ();
 143
 144     if ($client_status != 0) {
 145         print STDERR "ERROR: client returned $client_status\n";
 146         $SV->Kill (); $SV->TimedWait (1);
 147         $CL1->Kill (); $CL1->TimedWait (1);
 148         $CL2->Kill (); $CL2->TimedWait (1);
 149         exit 1;
 150     }
 151 }
 152
 153 if ($clients > 0) {
 154     $client_status = $CL1->WaitKill ($client1->ProcessStopWaitInterval() + 195);
 155
 156     if ($client_status != 0) {
 157         print STDERR "ERROR: client 1 returned $client_status\n";
 158         $status = 1;
 159     }
 160 }
 161
 162 if ($clients > 1) {
 163     $client_status = $CL2->WaitKill ($client2->ProcessStopWaitInterval());
 164
 165     if ($client_status != 0) {
 166         print STDERR "ERROR: client 2 returned $client_status\n";
 167         $status = 1;
 168     }
 169 }
 170
 171 if ($clients > 2) {
 172     $client_status = $CL3->WaitKill ($client3->ProcessStopWaitInterval());
 173
 174     if ($client_status != 0) {
 175         print STDERR "ERROR: client 3 returned $client_status\n";
 176         $status = 1;
 177     }
 178 }
 179
 180 $CL1->Arguments ("-l $corbaloc_str -i 1 -x ".
 181                  "-k file://$client1_iorfile");
 182
 183 $client_status = $CL1->SpawnWaitKill ($client1->ProcessStartWaitInterval());
 184
 185 if ($client_status != 0) {
 186     print STDERR "ERROR: client returned $client_status\n";
 187     $SV->Kill (); $SV->TimedWait (1);
 188     exit 1;
 189 }
 190
 191 $server_status = $SV->WaitKill ($server->ProcessStopWaitInterval() + 135);
 192
 193 if ($server_status != 0) {
 194     print STDERR "ERROR: server returned $server_status\n";
 195     $status = 1;
 196 }
 197
 198 $server->DeleteFile($iorbase);
 199 $server->DeleteFile($logbase);
 200 $client1->DeleteFile($iorbase);
 201 $client1->DeleteFile($logbase);
 202 $client2->DeleteFile($iorbase);
 203 $client2->DeleteFile($logbase);
 204 $client3->DeleteFile($iorbase);
 205 $client3->DeleteFile($logbase);
 206
 207 exit $status;