TAO/orbsvcs/DevGuideExamples/ImplRepo/IORTable/run_test.pl

   1
   2 eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}'
   3     & eval 'exec perl -S $0 $argv:q'
   4     if 0;
   5
   6 use lib "$ENV{ACE_ROOT}/bin";
   7 use PerlACE::TestTarget;
   8
   9 $status = 0;
  10 $debug_level = '0';
  11
  12 foreach $i (@ARGV) {
  13     if ($i eq '-debug') {
  14         $debug_level = '10';
  15     }
  16 }
  17
  18 my $c1 = PerlACE::TestTarget::create_target (1) || die "Create target 1 failed\n";
  19 my $imr = PerlACE::TestTarget::create_target (2) || die "Create target 2 failed\n";
  20 my $ti = PerlACE::TestTarget::create_target (3) || die "Create target 3 failed\n";
  21
  22 my $WAIT_TIMEOUT = 2;
  23 my $DEBUG_LEVEL = 1;
  24 my $OBJ_REF_STYLE = "-orbobjrefstyle url";
  25
  26 my $implrepo_server = "$ENV{TAO_ROOT}/orbsvcs/ImplRepo_Service/tao_imr_locator";
  27 my $tao_imr = "$ENV{ACE_ROOT}/bin/tao_imr";
  28
  29 my $implrepo_ior = "imr.ior";
  30 my $messenger1_ior = "messenger1.ior";
  31 my $messenger2_ior = "messenger2.ior";
  32 my $messenger3_ior = "messenger3.ior";
  33 my $messenger4_ior = "messenger4.ior";
  34
  35 my $imr_imriorfile = $imr->LocalFile ($implrepo_ior);
  36 my $ti_imriorfile = $ti->LocalFile ($implrepo_ior);
  37 my $imr_m1iorfile = $imr->LocalFile ($messenger1_ior);
  38 my $c1_m1iorfile = $c1->LocalFile ($messenger1_ior);
  39 my $imr_m2iorfile = $imr->LocalFile ($messenger2_ior);
  40 my $c1_m2iorfile = $c1->LocalFile ($messenger2_ior);
  41 my $c1_m3iorfile = $c1->LocalFile ($messenger3_ior);
  42 my $ti_m3iorfile = $ti->LocalFile ($messenger3_ior);
  43 my $c1_m4iorfile = $c1->LocalFile ($messenger4_ior);
  44 my $ti_m4iorfile = $ti->LocalFile ($messenger4_ior);
  45
  46 sub CleanupOutput {
  47     $imr->DeleteFile ($implrepo_ior);
  48     $ti->DeleteFile ($implrepo_ior);
  49     $imr->DeleteFile ($messenger1_ior);
  50     $c1->DeleteFile ($messenger1_ior);
  51     $imr->DeleteFile ($messenger2_ior);
  52     $c1->DeleteFile ($messenger2_ior);
  53     $c1->DeleteFile ($messenger3_ior);
  54     $ti->DeleteFile ($messenger3_ior);
  55     $c1->DeleteFile ($messenger4_ior);
  56     $ti->DeleteFile ($messenger4_ior);
  57 }
  58
  59 sub SpawnWait {
  60     my $process = shift;
  61     my $file = shift;
  62     my $target = shift;
  63
  64     print ">>> " . $process->CommandLine () . "\n";
  65     my $status = $process->Spawn ();
  66     if ($status != 0) {
  67         print STDERR "ERROR: Process returned $status\n";
  68         return 1;
  69     }
  70     my $ret = $target->WaitForFileTimed ($file,$target->ProcessStartWaitInterval());
  71     if ($ret == -1) {
  72          print STDERR "ERROR: Cannot find file <$file>\n";
  73     }
  74     return $ret;
  75 }
  76
  77 sub SpawnWaitKill {
  78     my $process = shift;
  79     my $target = shift;
  80
  81     print ">>> " . $process->CommandLine() . "\n";
  82     return $process->SpawnWaitKill($target->ProcessStartWaitInterval());
  83 }
  84
  85 sub RunImRUtil {
  86     my $cmd = shift;
  87
  88     print ">>> " . $TI->CommandLine() . "\n";
  89     $TI->Arguments("-ORBInitRef ImplRepoService=file://$ti_imriorfile $cmd");
  90     return $TI->SpawnWaitKill($ti->ProcessStartWaitInterval());
  91 }
  92
  93
  94 $Srv = $imr->CreateProcess ("MessengerServer", "-ORBdebuglevel $debug_level ".
  95                                             "-orbuseimr 1 ".
  96                                             "$OBJ_REF_STYLE ".
  97                                             "-o $imr_m1iorfile ".
  98                                             "-i $imr_m2iorfile ".
  99                                             "-ORBInitRef ImplRepoService=file://$imr_imriorfile");
 100 my $server_cmd = $Srv->Executable();
 101 my $srv_server_cmd = $imr->LocalFile ($server_cmd);
 102 $C1 = $c1->CreateProcess ("MessengerClient");
 103
 104 # Use url object reference style for readability, and startup timeout of 2 seconds.
 105 # Unlike the chapter we'll forgo using -m, because we want to be able to run this
 106 # as a test in our nightly builds, and multicast could interfere with other machines.
 107 $ImR = $imr->CreateProcess ($implrepo_server, "-d $DEBUG_LEVEL ".
 108                                                "$OBJ_REF_STYLE ".
 109                                                "-t 2 ".
 110                                                "-o $imr_imriorfile");
 111
 112 $TI = $ti->CreateProcess ($tao_imr, "-ORBInitRef ImplRepoService=file://$ti_imriorfile ".
 113                                     "add MessengerService ".
 114                                     "-c \"$srv_server_cmd $OBJ_REF_STYLE -ORBUseIMR 1 -ORBInitRef ImplRepoService=file://$imr_imriorfile\"");
 115
 116 # We want the tao_imr executable to be found exactly in the path
 117 # given, without being modified by the value of -ExeSubDir.
 118 # So, we tell its Process object to ignore the setting of -ExeSubDir.
 119 $TI->IgnoreExeSubDir(1);
 120
 121 CleanupOutput();
 122
 123 #### Start the example
 124
 125 if (SpawnWait($ImR, $implrepo_ior, $imr) != 0) {
 126     $ImR->Kill(); $ImR->TimedWait(1);
 127     exit 1;
 128 }
 129 if ($imr->GetFile ($implrepo_ior) == -1) {
 130     print STDERR "ERROR: cannot retrieve file <$imr_imriorfile>\n";
 131     $ImR->Kill (); $ImR->TimedWait (1);
 132     exit 1;
 133 }
 134 if ($ti->PutFile ($implrepo_ior) == -1) {
 135     print STDERR "ERROR: cannot set file <$ti_imriorfile>\n";
 136     $ImR->Kill (); $ImR->TimedWait (1);
 137     exit 1;
 138 }
 139
 140 if (SpawnWait($Srv, $messenger2_ior, $imr) != 0) {
 141     $ImR->Kill (); $ImR->TimedWait (1);
 142     exit 1;
 143 }
 144 if ($imr->GetFile ($messenger1_ior) == -1) {
 145     print STDERR "ERROR: cannot retrieve file <$imr_m1iorfile>\n";
 146     $ImR->Kill (); $ImR->TimedWait (1);
 147     exit 1;
 148 }
 149 if ($c1->PutFile ($messenger1_ior) == -1) {
 150     print STDERR "ERROR: cannot set file <$c1_m1iorfile>\n";
 151     $ImR->Kill (); $ImR->TimedWait (1);
 152     exit 1;
 153 }
 154 if ($imr->GetFile ($messenger2_ior) == -1) {
 155     print STDERR "ERROR: cannot retrieve file <$imr_m2iorfile>\n";
 156     $ImR->Kill (); $ImR->TimedWait (1);
 157     exit 1;
 158 }
 159 if ($c1->PutFile ($messenger2_ior) == -1) {
 160     print STDERR "ERROR: cannot set file <$c1_m2iorfile>\n";
 161     $ImR->Kill (); $ImR->TimedWait (1);
 162     exit 1;
 163 }
 164
 165 $C1->Arguments($c1_m1iorfile);
 166 if (SpawnWaitKill($C1, $c1) != 0) {
 167     print STDERR "Error : Client 1 failed to run correctly.";
 168     $status = 1;
 169 }
 170
 171 $C1->Arguments($c1_m2iorfile);
 172 if (SpawnWaitKill($C1, $c1) != 0) {
 173     print STDERR "Error : Client 2 failed to run correctly.";
 174     $status = 1;
 175 }
 176
 177 #Since we didn't start the ImR with a known endpoint, we'll
 178 #have to use the tao_imr utility to create a our urls.
 179 RunImRUtil("ior MessengerService/Object1 -f $ti_m3iorfile");
 180 RunImRUtil("ior MessengerService/Object2 -f $ti_m4iorfile");
 181 if ($ti->GetFile ($messenger3_ior) == -1) {
 182     print STDERR "ERROR: cannot retrieve file <$ti_m3iorfile>\n";
 183     $ImR->Kill (); $ImR->TimedWait (1);
 184     exit 1;
 185 }
 186 if ($c1->PutFile ($messenger3_ior) == -1) {
 187     print STDERR "ERROR: cannot set file <$c1_m3iorfile>\n";
 188     $ImR->Kill (); $ImR->TimedWait (1);
 189     exit 1;
 190 }
 191 if ($ti->GetFile ($messenger4_ior) == -1) {
 192     print STDERR "ERROR: cannot retrieve file <$ti_m4iorfile>\n";
 193     $ImR->Kill (); $ImR->TimedWait (1);
 194     exit 1;
 195 }
 196 if ($c1->PutFile ($messenger4_ior) == -1) {
 197     print STDERR "ERROR: cannot set file <$c1_m4iorfile>\n";
 198     $ImR->Kill (); $ImR->TimedWait (1);
 199     exit 1;
 200 }
 201
 202
 203 $C1->Arguments($c1_m3iorfile);
 204 if (SpawnWaitKill($C1, $c1) != 0) {
 205     print STDERR "Error : Client 3 failed to run correctly.";
 206     $status = 1;
 207 }
 208
 209 # Notice that this one results in two calls through the ImR, because
 210 # we bound an indirect reference in the IORTable. If we were using
 211 # PER_CLIENT activation, this would be bad.
 212 $C1->Arguments($c1_m4iorfile);
 213 if (SpawnWaitKill($C1, $c1) != 0) {
 214     print STDERR "Error : Client 4 failed to run correctly.";
 215     $status = 1;
 216 }
 217
 218 $Srv_status = $Srv->TerminateWaitKill ($imr->ProcessStopWaitInterval());
 219
 220 if ($Srv_status != 0) {
 221     print STDERR "ERROR: Server returned $Srv_status\n";
 222     $status = 1;
 223 }
 224
 225 $ImR_status = $ImR->TerminateWaitKill ($imr->ProcessStopWaitInterval());
 226
 227 if ($ImR_status != 0) {
 228     print STDERR "ERROR: ImplRepo Service returned $ImR_status\n";
 229     $status = 1;
 230 }
 231
 232 #### Clean up any output files
 233
 234 CleanupOutput();
 235
 236 exit $status;