TAO/orbsvcs/tests/ImplRepo/PICurrent/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 use lib "$ENV{ACE_ROOT}/bin";
   6 use PerlACE::TestTarget;
   7
   8 $status = 0;
   9 $mode = "-a NORMAL ";
  10
  11 $debugging = 0;
  12 $imr_debug = "-d 0 ";
  13 $act_debug = "-d 0 ";
  14 $svr_debug = " ";
  15 $clt_debug = " ";
  16
  17 foreach $i (@ARGV) {
  18     if ($i eq '-debug') {
  19         $debugging = 1;
  20         $imr_debug = "-ORBDebugLevel 10 -ORBVerboseLogging 1 -ORBLogFile imr.log -d 5 ";
  21         $act_debug = "-ORBDebugLevel 10 -ORBVerboseLogging 1 -ORBLogFile act.log -d 5 ";
  22         $svr_debug = "-ORBDebugLevel 10 -ORBVerboseLogging 1 -ORBLogFile svr.log ";
  23         $clt_debug = "-ORBDebugLevel 10 -ORBVerboseLogging 1 -ORBLogFile clt.log ";
  24     }
  25 }
  26
  27 my $extra_timeout = 345;
  28
  29 my $seconds_between_requests = 4;
  30
  31 # Valgrind may slow down processes enough that an extra delay
  32 # is needed between client requests.
  33 if (exists $ENV{'ACE_RUN_VALGRIND_CMD'}) {
  34     $seconds_between_requests = 10;
  35 }
  36
  37 my $c1 = PerlACE::TestTarget::create_target (1) || die "Create target 1 failed\n";
  38 my $imr = PerlACE::TestTarget::create_target (2) || die "Create target 3 failed\n";
  39 my $act = PerlACE::TestTarget::create_target (3) || die "Create target 4 failed\n";
  40 my $ti = PerlACE::TestTarget::create_target (4) || die "Create target 5 failed\n";
  41
  42 my $implrepo_server = "$ENV{TAO_ROOT}/orbsvcs/ImplRepo_Service/tao_imr_locator";
  43 my $imr_activator = "$ENV{TAO_ROOT}/orbsvcs/ImplRepo_Service/tao_imr_activator";
  44 my $tao_imr = "$ENV{ACE_ROOT}/bin/tao_imr";
  45
  46 my $implrepo_ior = "implrepo.ior";
  47 my $activator_ior = "activator.ior";
  48 my $test_ior = "test.ior";
  49 my $imrlogfile = "imr.log";
  50 my $actlogfile = "act.log";
  51
  52 # Use client strategy factory for one of retry parameters.
  53 $c1_conf = "client.conf";
  54
  55 my $imr_imriorfile = $imr->LocalFile ($implrepo_ior);
  56 my $act_imriorfile = $act->LocalFile ($implrepo_ior);
  57 my $ti_imriorfile = $ti->LocalFile ($implrepo_ior);
  58 my $act_actiorfile = $act->LocalFile ($activator_ior);
  59 my $c1_srviorfile = $c1->LocalFile ($test_ior);
  60 my $c1_conffile = $c1->LocalFile ($c1_conf);
  61 my $act_srviorfile = $ti->LocalFile ($test_ior);
  62
  63 # Make sure the files are gone, so we can wait on them.
  64 sub delete_files
  65 {
  66     my $logs_too = shift;
  67     if ($logs_too == 1) {
  68         $imr->DeleteFile ($imrlogfile);
  69         $act->DeleteFile ($actlogfile);
  70     }
  71     $imr->DeleteFile ($implrepo_ior);
  72     $act->DeleteFile ($implrepo_ior);
  73     $ti->DeleteFile ($implrepo_ior);
  74     $act->DeleteFile ($activator_ior);
  75     $act->DeleteFile ($test_ior);
  76     $c1->DeleteFile ($test_ior);
  77 }
  78
  79 # Clean up after exit call
  80 END
  81 {
  82     delete_files (0);
  83 }
  84
  85 delete_files (1);
  86
  87 # Note : We don't actually use SVR, but we need a way to get the
  88 #        path to the -ExeSubDir
  89 $SVR = $imr->CreateProcess ("server", "");
  90 my $server = $SVR->Executable ();
  91 my $srv_server = $imr->LocalFile ($server);
  92
  93 $IR = $imr->CreateProcess ($implrepo_server, $imr_debug .
  94                            "-orbobjrefstyle url ".
  95                            "-v 1000 -t 5 ".
  96                            "-o $imr_imriorfile ");
  97 print ">>> " . $IR->CommandLine() . "\n";
  98
  99 my $initrefbase = "-ORBInitRef ImplRepoService=file://";
 100 my $actinitref = $initrefbase . $act_imriorfile;
 101 my $tiinitref = $initrefbase . $ti_imriorfile;
 102 $ACT = $act->CreateProcess ($imr_activator, " " .
 103                             $act_debug .
 104                             "-orbobjrefstyle url " .
 105                             "-o $act_actiorfile " .
 106                             $actinitref);
 107
 108 my $client_cmdline = "-k file://$c1_srviorfile ".
 109     "-ORBSvcConf $c1_conffile ".
 110     $clt_debug;
 111
 112 $C1 = $c1->CreateProcess ("client", $client_cmdline);
 113
 114 $TI = $ti->CreateProcess ($tao_imr);
 115 $TI->IgnoreExeSubDir (1);
 116
 117 sub kill_imr
 118 {
 119     my $msg = shift;
 120     print STDERR "ERROR: $msg\n" if (length ($msg) > 0);
 121     $ACT->Kill (); $ACT->TimedWait (1);
 122     $IR->Kill (); $IR->TimedWait (1);
 123     return 1;
 124 }
 125
 126 sub ti_cmd
 127 {
 128     my $cmd = shift;
 129     my $cmdargs = shift;
 130
 131     my $obj_name = "TestService";
 132     print "invoking ti cmd $cmd $obj_name $cmdargs\n";# if ($debugging);
 133     $TI->Arguments ("$tiinitref $cmd $obj_name $cmdargs");
 134     $TI_status = $TI->SpawnWaitKill ($ti->ProcessStartWaitInterval() + $extra_timeout);
 135     if ($TI_status != 0 && $TI_status != 4) {
 136         return kill_imr ("tao_imr $cmd $obj_name returned $TI_status");
 137     }
 138     return 0;
 139 }
 140
 141 $IR_status = $IR->Spawn ();
 142
 143 if ($IR_status != 0) {
 144     print STDERR "ERROR: ImplRepo Service returned $IR_status\n";
 145     exit 1;
 146 }
 147
 148 if ($imr->WaitForFileTimed ($implrepo_ior,$imr->ProcessStartWaitInterval() + $extra_timeout) == -1) {
 149     print STDERR "ERROR: cannot find file <$imr_imriorfile>\n";
 150     $IR->Kill (); $IR->TimedWait (1);
 151     exit 1;
 152 }
 153
 154 if ($imr->GetFile ($implrepo_ior) == -1) {
 155     print STDERR "ERROR: cannot retrieve file <$imr_imriorfile>\n";
 156     $IR->Kill (); $IR->TimedWait (1);
 157     exit 1;
 158 }
 159 if ($act->PutFile ($implrepo_ior) == -1) {
 160     print STDERR "ERROR: cannot set file <$act_imriorfile>\n";
 161     $IR->Kill (); $IR->TimedWait (1);
 162     exit 1;
 163 }
 164 if ($ti->PutFile ($implrepo_ior) == -1) {
 165     print STDERR "ERROR: cannot set file <$ti_imriorfile>\n";
 166     $IR->Kill (); $IR->TimedWait (1);
 167     exit 1;
 168 }
 169
 170 print ">>> " . $ACT->CommandLine() . "\n";
 171 $ACT_status = $ACT->Spawn ();
 172
 173 if ($ACT_status != 0) {
 174     print STDERR "ERROR: ImR_Activator returned $ACT_status\n";
 175     $IR->Kill (); $IR->TimedWait (1);
 176     exit 1;
 177 }
 178
 179 if ($act->WaitForFileTimed ($activator_ior,$act->ProcessStartWaitInterval() + $extra_timeout) == -1) {
 180     kill_imr ("cannot find file <$act_actiorfile>");
 181     exit 1;
 182 }
 183
 184 my $srv_cmdline = "$srv_server $svr_debug -orbobjrefstyle url -ORBUseIMR 1 $actinitref";
 185
 186 if (ti_cmd ("add", $mode . "-c \"$srv_cmdline\" ")) {
 187     exit 1;
 188 }
 189
 190 if (ti_cmd ("ior", "-f $act_srviorfile")) {
 191     exit 1;
 192 }
 193 else {
 194     if ($act->WaitForFileTimed ($test_ior,$act->ProcessStartWaitInterval() + $extra_timeout) == -1) {
 195         kill_imr ("cannot find file <$act_srviorfile>");
 196         exit 1;
 197     }
 198
 199     if ($act->GetFile ($test_ior) == -1) {
 200         kill_imr ("cannot retrieve file <$act_srviorfile>");
 201         exit 1;
 202     }
 203
 204     if ($c1->PutFile ($test_ior) == -1) {
 205         kill_imr ("cannot set file <$c1_srviorfile>");
 206         exit 1;
 207     }
 208 }
 209
 210 print ">>> " . $C1->CommandLine() . "\n";
 211 $C1_status = $C1->SpawnWaitKill ($c1->ProcessStartWaitInterval() + $extra_timeout);
 212
 213 if ($C1_status == 2) {
 214     print STDERR "Warning: This test does not currently run under this operating system.\n";
 215     kill_imr ();
 216     exit 0;
 217 }
 218 elsif ($C1_status != 0) {
 219     kill_imr ("Client1 returned $C1_status");
 220     exit 1;
 221 }
 222
 223 ti_cmd ("shutdown");
 224 kill_imr ();
 225
 226 exit $status;