TAO/orbsvcs/tests/Bug_1395_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
  10 $status = 0;
  11 $debug_level = '0';
  12
  13 foreach $i (@ARGV) {
  14     if ($i eq '-debug') {
  15         $debug_level = '10';
  16     }
  17 }
  18
  19 my $server    = PerlACE::TestTarget::create_target (1) || die "Create target 1 failed\n";
  20 my $client    = PerlACE::TestTarget::create_target (2) || die "Create target 2 failed\n";
  21 my $locator   = PerlACE::TestTarget::create_target (3) || die "Create target 3 failed\n";
  22 my $activator = PerlACE::TestTarget::create_target (4) || die "Create target 4 failed\n";
  23 my $tao_imr   = PerlACE::TestTarget::create_target (5) || die "Create target 5 failed\n";
  24
  25 # The location of the implementation repository binaries
  26 my $imr_bin_path  = "$ENV{TAO_ROOT}/orbsvcs/ImplRepo_Service";
  27 # The location of the tao_imr IMR utility
  28 my $tao_imr_bin_path = "$ENV{ACE_ROOT}/bin";
  29
  30 # Run the IMR locator on a fixed port
  31 my $port = $locator->RandomPort();
  32
  33 my $imr_ior  = "impl.ior";
  34 my $actv_ior = "activator.ior";
  35 my $srv_ior  = "server.ior";
  36
  37 my $server_srv_ior     = $server->LocalFile ($srv_ior);
  38 my $server_imr_ior     = $server->LocalFile ($imr_ior);
  39 my $client_srv_ior     = $client->LocalFile ($srv_ior);
  40 my $locator_imr_ior    = $locator->LocalFile ($imr_ior);
  41 my $tao_imr_imr_ior    = $tao_imr->LocalFile ($imr_ior);
  42 my $activator_actv_ior = $activator->LocalFile ($actv_ior);
  43 my $activator_imr_ior  = $activator->LocalFile ($imr_ior);
  44 $server->DeleteFile($srv_ior);
  45 $server->DeleteFile($imr_ior);
  46 $client->DeleteFile($srv_ior);
  47 $locator->DeleteFile ($imr_ior);
  48 $tao_imr->DeleteFile ($imr_ior);
  49 $activator->DeleteFile ($actv_ior);
  50 $activator->DeleteFile ($imr_ior);
  51
  52 $SV = $server->CreateProcess ("server", "-ORBdebuglevel $debug_level -o $server_srv_ior ".
  53                                         "-ORBInitRef ImplRepoService=file://$server_imr_ior ".
  54                                         "-ORBUseIMR 1");
  55 $CL = $client->CreateProcess ("client", "-k file://$client_srv_ior");
  56 $LC = $locator->CreateProcess ("$imr_bin_path/tao_imr_locator", "-o $locator_imr_ior ".
  57                                                                  "-ORBEndpoint iiop://:$port");
  58 $AC = $activator->CreateProcess ("$imr_bin_path/tao_imr_activator",
  59                                  "-o $activator_actv_ior ".
  60                                  "-ORBInitRef ImplRepoService=file://$activator_imr_ior");
  61
  62 $TI = $tao_imr->CreateProcess ("$tao_imr_bin_path/tao_imr",
  63                                "add MyPoa -ORBInitRef ImplRepoService=file://$tao_imr_imr_ior");
  64 sub run_locator {
  65     $server->DeleteFile($imr_ior);
  66     $locator->DeleteFile ($imr_ior);
  67     $tao_imr->DeleteFile ($imr_ior);
  68     $activator->DeleteFile ($imr_ior);
  69
  70     $process_status = $LC->Spawn ();
  71
  72     if ($process_status != 0) {
  73         print STDERR "ERROR: locator returned $process_status\n";
  74         return 1;
  75     }
  76
  77     if ($locator->WaitForFileTimed ($imr_ior,
  78                                     $locator->ProcessStartWaitInterval()) == -1) {
  79         print STDERR "ERROR: cannot find file <$locator_imr_ior>\n";
  80         $LC->Kill (); $LC->TimedWait (1);
  81         return 1;
  82     }
  83
  84     if ($locator->GetFile ($imr_ior) == -1) {
  85         print STDERR "ERROR: cannot retrieve file <$locator_imr_ior>\n";
  86         $LC->Kill (); $LC->TimedWait (1);
  87         return 1;
  88     }
  89
  90     if ($server->PutFile ($imr_ior) == -1) {
  91         print STDERR "ERROR: cannot set file <$server_imr_ior>\n";
  92         $LC->Kill (); $LC->TimedWait (1);
  93         return 1;
  94     }
  95
  96     if ($tao_imr->PutFile ($imr_ior) == -1) {
  97         print STDERR "ERROR: cannot set file <$tao_imr_imr_ior>\n";
  98         $LC->Kill (); $LC->TimedWait (1);
  99         return 1;
 100     }
 101
 102     if ($activator->PutFile ($imr_ior) == -1) {
 103         print STDERR "ERROR: cannot set file <$activator_imr_ior>\n";
 104         $LC->Kill (); $LC->TimedWait (1);
 105         return 1;
 106     }
 107
 108     return 0;
 109 }
 110
 111 sub run_server {
 112     $server->DeleteFile($srv_ior);
 113     $client->DeleteFile($srv_ior);
 114
 115     $process_status = $SV->Spawn ();
 116
 117     if ($process_status != 0) {
 118         print STDERR "ERROR: server returned $process_status\n";
 119         return 1;
 120     }
 121
 122     if ($server->WaitForFileTimed ($srv_ior,
 123                                    $server->ProcessStartWaitInterval()) == -1) {
 124         print STDERR "ERROR: cannot find file <$server_srv_ior>\n";
 125         $SV->Kill (); $SV->TimedWait (1);
 126         return 1;
 127     }
 128
 129     if ($server->GetFile ($srv_ior) == -1) {
 130         print STDERR "ERROR: cannot retrieve file <$server_srv_ior>\n";
 131         $SV->Kill (); $SV->TimedWait (1);
 132         return 1;
 133     }
 134
 135     if ($client->PutFile ($srv_ior) == -1) {
 136         print STDERR "ERROR: cannot set file <$client_srv_ior>\n";
 137         $SV->Kill (); $SV->TimedWait (1);
 138         return 1;
 139     }
 140     return 0;
 141 }
 142
 143 sub test_body {
 144     # Start the IMR locator to generate an IOR file for the server to use...
 145     $process_status = run_locator();
 146
 147     if ($process_status != 0) {
 148         print STDERR "ERROR: run_locator returned $process_status\n";
 149         return 1;
 150     }
 151
 152     # ...then shut it down so that the server will not be able to contact it
 153     $process_status = $LC->TerminateWaitKill ($locator->ProcessStopWaitInterval());
 154
 155     if ($process_status != 0) {
 156         print STDERR "ERROR: locator returned $process_status\n";
 157         return 1;
 158     }
 159
 160     # Start our server
 161     $process_status = run_server();
 162
 163     if ($process_status != 0) {
 164         print STDERR "ERROR: run_server returned $process_status\n";
 165         return 1;
 166     }
 167
 168     # Use the client to ask the server to try and create a persistent POA
 169     # We expect this to 'fail' as the IMR is dead
 170     $process_status = $CL->SpawnWaitKill ($client->ProcessStartWaitInterval() + 15);
 171
 172     if ($process_status == 0) {
 173         print STDERR "ERROR: First create POA attempt succeeded when it shouldn't have done\n";
 174         $SV->Kill (); $SV->TimedWait (1);
 175         return 1;
 176     }
 177
 178     # Now we restart the IMR locator
 179     $process_status = run_locator ();
 180
 181     if ($process_status != 0) {
 182         print STDERR "ERROR: run_locator returned $process_status\n";
 183         return 1;
 184     }
 185
 186     # Work out the IMR activator command line.
 187     # Use the '-a' switch if this is a regression for bug #1394, else not
 188     if ($use_tao_imr_util == 0) {
 189         my $activator_args = $activator->Arguments();
 190         $activator->Arguments("$activator_args -a");
 191     }
 192
 193    # Start up the activator
 194     $process_status = $AC->Spawn ();
 195
 196     if ($process_status != 0) {
 197         print STDERR "ERROR: activator returned $process_status\n";
 198         return 1;
 199     }
 200
 201     if ($activator->WaitForFileTimed ($actv_ior,
 202                                       $activator->ProcessStartWaitInterval()) == -1) {
 203         print STDERR "ERROR: cannot find file <$activator_actv_ior>\n";
 204         $AC->Kill (); $AC->TimedWait (1);
 205         $LC->Kill (); $LC->TimedWait (1);
 206         return 1;
 207     }
 208
 209     ## Since we have restarted the locator, we need to restart
 210     ## the server so that it can pick up the new locator IOR
 211     $SV->Kill (); $SV->TimedWait (1);
 212
 213     $process_status = run_server();
 214
 215     if ($process_status != 0) {
 216         print STDERR "ERROR: run_server returned $process_status\n";
 217         $AC->Kill (); $AC->TimedWait (1);
 218         $LC->Kill (); $LC->TimedWait (1);
 219         return 1;
 220     }
 221
 222     # If this is just a regression for bug #1395 we need to register the POA
 223     # If it is a regression for enhancement bug #1394, we don't need to.
 224     if ($use_tao_imr_util != 0) {
 225         # Add the persistent POA name to the IMR
 226         $process_status = $TI->SpawnWaitKill ($tao_imr->ProcessStartWaitInterval() + 15);
 227
 228         if ($process_status != 0) {
 229             print STDERR "ERROR: tao_imr returned $process_status\n";
 230             $AC->Kill (); $AC->TimedWait (1);
 231             $LC->Kill (); $LC->TimedWait (1);
 232             return 1;
 233         }
 234     }
 235
 236     # Use the client to tell the server to attempt to create the POA again
 237     $process_status = $CL->SpawnWaitKill ($client->ProcessStartWaitInterval() + 15);
 238
 239     if ($process_status != 0) {
 240         print STDERR "ERROR: Second create POA attempt failed when it should have succeeded\n";
 241         $SV->Kill (); $SV->TimedWait (1);
 242         $AC->Kill (); $AC->TimedWait (1);
 243         $LC->Kill (); $LC->TimedWait (1);
 244         return 1;
 245     }
 246
 247    # Tidy up
 248     $process_status = $SV->TerminateWaitKill ($server->ProcessStopWaitInterval());
 249
 250     if ($process_status != 0) {
 251         print STDERR "ERROR: server returned $process_status\n";
 252         $status = 1;
 253     }
 254
 255     $process_status = $LC->TerminateWaitKill ($locator->ProcessStopWaitInterval());
 256
 257     if ($process_status != 0) {
 258         print STDERR "ERROR: locator returned $process_status\n";
 259         $status = 1;
 260     }
 261
 262     $process_status = $AC->TerminateWaitKill ($activator->ProcessStopWaitInterval());
 263
 264     if ($process_status != 0) {
 265         print STDERR "ERROR: activator returned $process_status\n";
 266         $status = 1;
 267     }
 268
 269    return $status;
 270 }
 271
 272 # Run regression for bug #1395
 273 $use_tao_imr_util = 1;
 274 $status = test_body();
 275
 276 if ($status != 0) {
 277     print STDERR "ERROR: Regression test for Bug #1395 failed\n";
 278 }
 279
 280 # Bug 1394 is an enhancement so will not be submitted until after TAO1.3.1
 281 # Uncomment the following to activate regression after submission and ..
 282 # Run regression for bug #1394
 283 #$use_tao_imr_util = 0;
 284 #$test_result = test_body();
 285 #if ($test_result != 0)
 286 #{
 287 #   print STDERR "ERROR: Regression test for Bug #1394 failed\n";
 288 #}
 289
 290 exit $status;