TAO/orbsvcs/tests/Miop/McastFragmentation/run_test_ipv6.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 $server_level = '0';
  12 $client_level = '0';
  13
  14 $orbs = 10;
  15 $payload = 3000;
  16 $threads = 5;
  17 $count = 5;
  18
  19 foreach $i (@ARGV) {
  20     if ($i eq '-debug') {
  21         $server_level = '3';
  22         # Level enough for reporting errors.
  23         $client_level = '9';
  24     }
  25 }
  26
  27 my $server = PerlACE::TestTarget::create_target (1) || die "Create target 1 failed\n";
  28 my $client1 = PerlACE::TestTarget::create_target (2) || die "Create target 2 failed\n";
  29 my $client2 = PerlACE::TestTarget::create_target (3) || die "Create target 3 failed\n";
  30 my $client3 = PerlACE::TestTarget::create_target (4) || die "Create target 4 failed\n";
  31
  32 $uipmc = "corbaloc:miop:1.0\@1.0-domain-1/[FF01:0:0:0:0:10:10:10]:" . $server->RandomPort();
  33
  34 my $c_svcconf = "uipmc_client$PerlACE::svcconf_ext";
  35 my $s_svcconf = "uipmc_server$PerlACE::svcconf_ext";
  36 my $cleanup_select = int rand (3);
  37 if ($cleanup_select == 1) {
  38     $s_svcconf = "uipmc_server_n$PerlACE::svcconf_ext";
  39 } elsif ($cleanup_select == 2) {
  40     $s_svcconf = "uipmc_server_m$PerlACE::svcconf_ext";
  41 }
  42 print STDOUT "Using $s_svcconf for the server initialization\n";
  43
  44 my $iorbase = "server.ior";
  45 my $server_iorfile = $server->LocalFile ($iorbase);
  46 my $server_svcconf = $server->LocalFile ($s_svcconf);
  47 my $client1_iorfile = $client1->LocalFile ($iorbase);
  48 my $client1_svcconf = $client1->LocalFile ($c_svcconf);
  49 my $client2_iorfile = $client2->LocalFile ($iorbase);
  50 my $client2_svcconf = $client2->LocalFile ($c_svcconf);
  51 my $client3_iorfile = $client3->LocalFile ($iorbase);
  52 my $client3_svcconf = $client3->LocalFile ($c_svcconf);
  53 $server->DeleteFile($iorbase);
  54 $client1->DeleteFile($iorbase);
  55 $client2->DeleteFile($iorbase);
  56 $client3->DeleteFile($iorbase);
  57
  58 $SV = $server->CreateProcess ("server",
  59                               "-ORBdebuglevel $server_level " .
  60                               "-ORBSvcConf $server_svcconf " .
  61                               "-o $server_iorfile -u $uipmc -s $orbs " .
  62                               "-p $payload -t " .
  63                               $threads * 1 . " -c $count");
  64 $CL1 = $client1->CreateProcess ("client",
  65                                 "-ORBSvcConf $client1_svcconf " .
  66                                 "-ORBDebugLevel $client_level " .
  67                                 "-k file://$client1_iorfile -p $payload " .
  68                                 "-t $threads -c $count -f 0");
  69 =COMMENT
  70 $CL2 = $client2->CreateProcess ("client",
  71                                 "-ORBSvcConf $client2_svcconf " .
  72                                 "-k file://$client2_iorfile -p $payload " .
  73                                 "-t $threads -c $count -f $threads");
  74 $CL3 = $client3->CreateProcess ("client",
  75                                 "-ORBSvcConf $client3_svcconf " .
  76                                 "-k file://$client3_iorfile -p $payload " .
  77                                 "-t $threads -c $count " .
  78                                 "-f " . $threads * 2);
  79 =cut
  80
  81 $server_status = $SV->Spawn ();
  82
  83 if ($server_status != 0) {
  84     print STDERR "ERROR: server returned $server_status\n";
  85     exit 1;
  86 }
  87
  88 if ($server->WaitForFileTimed ($iorbase,
  89                                $server->ProcessStartWaitInterval()) == -1) {
  90     print STDERR "ERROR: cannot find file <$server_iorfile>\n";
  91     $SV->Kill (); $SV->TimedWait (1);
  92     exit 1;
  93 }
  94
  95 if ($server->GetFile ($iorbase) == -1) {
  96     print STDERR "ERROR: cannot retrieve file <$server_iorfile>\n";
  97     $SV->Kill (); $SV->TimedWait (1);
  98     exit 1;
  99 }
 100 if ($client1->PutFile ($iorbase) == -1) {
 101     print STDERR "ERROR: cannot set file <$client1_iorfile>\n";
 102     $SV->Kill (); $SV->TimedWait (1);
 103     exit 1;
 104 }
 105 if ($client2->PutFile ($iorbase) == -1) {
 106     print STDERR "ERROR: cannot set file <$client2_iorfile>\n";
 107     $SV->Kill (); $SV->TimedWait (1);
 108     exit 1;
 109 }
 110 if ($client3->PutFile ($iorbase) == -1) {
 111     print STDERR "ERROR: cannot set file <$client3_iorfile>\n";
 112     $SV->Kill (); $SV->TimedWait (1);
 113     exit 1;
 114 }
 115
 116 $client_status = $CL1->Spawn ();
 117 if ($client_status != 0) {
 118     print STDERR "ERROR: client returned $client_status\n";
 119     $SV->Kill (); $SV->TimedWait (1);
 120     exit 1;
 121 }
 122
 123 =COMMENT
 124 $client_status = $CL2->Spawn ();
 125 if ($client_status != 0) {
 126     print STDERR "ERROR: client returned $client_status\n";
 127     $SV->Kill (); $SV->TimedWait (1);
 128     $CL1->Kill (); $CL1->TimedWait (1);
 129     exit 1;
 130 }
 131
 132 $client_status = $CL3->Spawn ();
 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     $CL2->Kill (); $CL2->TimedWait (1);
 138     exit 1;
 139 }
 140 =cut
 141
 142 $client_status = $CL1->WaitKill ($client1->ProcessStopWaitInterval() +
 143                                  $count * $threads);
 144 if ($client_status != 0) {
 145     print STDERR "ERROR: client returned $client_status\n";
 146     $SV->Kill (); $SV->TimedWait (1);
 147     # $CL2->Kill (); $CL2->TimedWait (1);
 148     # $CL3->Kill (); $CL3->TimedWait (1);
 149     exit 1;
 150 }
 151
 152 =COMMENT
 153 $client_status = $CL2->WaitKill ($client2->ProcessStopWaitInterval() +
 154                                  $count * $threads);
 155 if ($client_status != 0) {
 156     print STDERR "ERROR: client returned $client_status\n";
 157     $SV->Kill (); $SV->TimedWait (1);
 158     $CL3->Kill (); $CL3->TimedWait (1);
 159     exit 1;
 160 }
 161
 162 $client_status = $CL3->WaitKill ($client3->ProcessStopWaitInterval() +
 163                                  $count * $threads);
 164 if ($client_status != 0) {
 165     print STDERR "ERROR: client returned $client_status\n";
 166     $SV->Kill (); $SV->TimedWait (1);
 167     exit 1;
 168 }
 169 =cut
 170
 171 # Shutdown the server.
 172 $CL1->Arguments ("-ORBSvcConf $client1_svcconf -k file://$client1_iorfile -x");
 173 $client_status = $CL1->Spawn ();
 174 if ($client_status != 0) {
 175     print STDERR "ERROR: client returned $client_status\n";
 176     $SV->Kill (); $SV->TimedWait (1);
 177     exit 1;
 178 }
 179
 180 $client_status = $CL1->WaitKill ($client1->ProcessStopWaitInterval());
 181 if ($client_status != 0) {
 182     print STDERR "ERROR: client returned $client_status\n";
 183     $SV->Kill (); $SV->TimedWait (1);
 184     exit 1;
 185 }
 186
 187 $server_status = $SV->WaitKill ($server->ProcessStopWaitInterval());
 188
 189 if ($server_status != 0) {
 190     print STDERR "ERROR: server returned $server_status\n";
 191     $status = 1;
 192 }
 193
 194 $server->DeleteFile($iorbase);
 195 $client1->DeleteFile($iorbase);
 196 $client2->DeleteFile($iorbase);
 197 $client3->DeleteFile($iorbase);
 198
 199 exit $status;