TAO/orbsvcs/DevGuideExamples/ImplRepo/Basic/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 $srv = PerlACE::TestTarget::create_target (1) || die "Create target 1 failed\n";
  19 my $cli = PerlACE::TestTarget::create_target (2) || die "Create target 2 failed\n";
  20 my $imr = 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
  28 my $implrepo_ior = "imr.ior";
  29 my $messenger_ior = "messenger.ior";
  30
  31 my $imr_imriorfile = $imr->LocalFile ($implrepo_ior);
  32 my $srv_imriorfile = $srv->LocalFile ($implrepo_ior);
  33 my $srv_srviorfile = $srv->LocalFile ($messenger_ior);
  34 my $cli_srviorfile = $cli->LocalFile ($messenger_ior);
  35
  36 $Srv = $srv->CreateProcess ("MessengerServer", "-ORBdebuglevel $debug_level ".
  37                                                "-orbuseimr 1 ".
  38                                                "$OBJ_REF_STYLE ".
  39                                                "-ORBInitRef ImplRepoService=file://$srv_imriorfile");
  40 $Cli = $cli->CreateProcess ("MessengerClient", "-k file://$cli_srviorfile");
  41
  42 sub CleanupOutput {
  43     $imr->DeleteFile ($implrepo_ior);
  44     $srv->DeleteFile ($implrepo_ior);
  45     $srv->DeleteFile ($messenger_ior);
  46     $cli->DeleteFile ($messenger_ior);
  47 }
  48
  49 # Use url object reference style for readability, and startup timeout of 2 seconds.
  50 # Unlike the chapter we'll forgo using -m, because we want to be able to run this
  51 # as a test in our nightly builds, and multicast could interfere with other machines.
  52 $ImR = $imr->CreateProcess ($implrepo_server, "-d $DEBUG_LEVEL ".
  53                                                "$OBJ_REF_STYLE ".
  54                                                "-t 2 ".
  55                                                "-o $imr_imriorfile");
  56
  57 CleanupOutput();
  58
  59 #### Start the example
  60 print ">>> " . $ImR->CommandLine() . "\n";
  61 $ImR_status = $ImR->Spawn ();
  62
  63 if ($ImR_status != 0) {
  64     print STDERR "ERROR: ImplRepo Service returned $ImR_status\n";
  65     exit 1;
  66 }
  67
  68 if ($imr->WaitForFileTimed ($implrepo_ior,$imr->ProcessStartWaitInterval()) == -1) {
  69     print STDERR "ERROR: cannot find file <$imr_imriorfile>\n";
  70     $ImR->Kill (); $ImR->TimedWait (1);
  71     exit 1;
  72 }
  73
  74 if ($imr->GetFile ($implrepo_ior) == -1) {
  75     print STDERR "ERROR: cannot retrieve file <$imr_imriorfile>\n";
  76     $ImR->Kill (); $ImR->TimedWait (1);
  77     exit 1;
  78 }
  79 if ($srv->PutFile ($implrepo_ior) == -1) {
  80     print STDERR "ERROR: cannot set file <$srv_imriorfile>\n";
  81     $ImR->Kill (); $ImR->TimedWait (1);
  82     exit 1;
  83 }
  84
  85 print ">>> " . $Srv->CommandLine() . "\n";
  86 $Srv_status = $Srv->Spawn ();
  87
  88 if ($Srv_status != 0) {
  89     print STDERR "ERROR: Server returned $Srv_status\n";
  90     $ImR->Kill (); $ImR->TimedWait (1);
  91     exit 1;
  92 }
  93
  94 if ($srv->WaitForFileTimed ($messenger_ior,$srv->ProcessStartWaitInterval()) == -1) {
  95     print STDERR "ERROR: cannot find file <$srv_srviorfile>\n";
  96     $Srv->Kill (); $Srv->TimedWait (1);
  97     $ImR->Kill (); $ImR->TimedWait (1);
  98     exit 1;
  99 }
 100
 101 if ($srv->GetFile ($messenger_ior) == -1) {
 102     print STDERR "ERROR: cannot retrieve file <$srv_srviorfile>\n";
 103     $Srv->Kill (); $Srv->TimedWait (1);
 104     $ImR->Kill (); $ImR->TimedWait (1);
 105     exit 1;
 106 }
 107 if ($cli->PutFile ($messenger_ior) == -1) {
 108     print STDERR "ERROR: cannot set file <$cli_srviorfile>\n";
 109     $Srv->Kill (); $Srv->TimedWait (1);
 110     $ImR->Kill (); $ImR->TimedWait (1);
 111     exit 1;
 112 }
 113
 114 $Cli_status = $Cli->SpawnWaitKill ($cli->ProcessStartWaitInterval());
 115 if ($Cli_status != 0) {
 116     print STDERR "ERROR: Client failed to run correctly. Client returned $Cli_status\n";
 117     $status = 1;
 118 }
 119
 120 $Srv_status = $Srv->TerminateWaitKill ($srv->ProcessStopWaitInterval());
 121
 122 if ($Srv_status != 0) {
 123     print STDERR "ERROR: Server returned $Srv_status\n";
 124     $status = 1;
 125 }
 126
 127 $ImR_status = $ImR->TerminateWaitKill ($imr->ProcessStopWaitInterval());
 128
 129 if ($ImR_status != 0) {
 130     print STDERR "ERROR: ImplRepo Service returned $ImR_status\n";
 131     $status = 1;
 132 }
 133
 134 #### Clean up any output files
 135
 136 CleanupOutput();
 137
 138 exit $status;