TAO/tests/AMH_Exceptions/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 # This is a Perl script that tests AMH exceptions
   8
   9 use lib "$ENV{ACE_ROOT}/bin";
  10 use PerlACE::TestTarget;
  11
  12 $debug_level = '0';
  13
  14 foreach $i (@ARGV) {
  15     if ($i eq '-debug') {
  16         $debug_level = '10';
  17     }
  18 }
  19
  20 my $target = PerlACE::TestTarget::create_target(1) || die "Create target 1 failed\n";
  21 my $host = PerlACE::TestTarget::create_target(2) || die "Create targer 2 failed\n";
  22
  23 # File used to pass AMH server ior to its clients.
  24 # This file name is hard-coded in the server.cpp and client.cpp files
  25 $iorbase = "test.ior";
  26 my $server_iorfile = $target->LocalFile ($iorbase);
  27 my $client_iorfile = $host->LocalFile ($iorbase);
  28 $target->DeleteFile($iorbase);
  29 $host->DeleteFile($iorbase);
  30
  31 $AMH = $target->CreateProcess ("server", "-ORBdebuglevel $debug_level -o $server_iorfile");
  32 $CL = $host->CreateProcess ("client", "-k file://$client_iorfile");
  33
  34 # Run the AMH server.
  35 $AMH->Spawn ();
  36
  37 if ($target->WaitForFileTimed ($iorbase,
  38                                $target->ProcessStartWaitInterval()) == -1) {
  39     print STDERR "ERROR: File containing AMH Server ior,".
  40         " <$iorbase>, cannot be found\n";
  41     $AMH->Kill ();
  42     exit 1;
  43 }
  44
  45 if ($target->GetFile ($iorbase) == -1) {
  46     print STDERR "ERROR: cannot retrieve file <$iorbase>\n";
  47     $AMH->Kill (); $AMH->TimedWait (1);
  48     exit 1;
  49 }
  50 if ($host->PutFile ($iorbase) == -1) {
  51     print STDERR "ERROR: cannot set file <$iorbase>\n";
  52     $AMH->Kill (); $AMH->TimedWait (1);
  53     exit 1;
  54 }
  55
  56 # Run client.
  57 $client_status = $CL->SpawnWaitKill ($host->ProcessStartWaitInterval() + 15);
  58
  59 if ($client_status != 0) {
  60     print STDERR "ERROR: client returned $client_status\n";
  61     $status = 1;
  62 }
  63
  64 # Clean up.
  65 $amhserver= $AMH->WaitKill ($target->ProcessStopWaitInterval());
  66
  67 if ($amhserver != 0) {
  68     print STDERR "ERROR: AMH Server returned $amhserver\n";
  69     $status = 1;
  70 }
  71
  72 $target->GetStderrLog();
  73 $host->DeleteFile($iorbase);
  74 $target->DeleteFile ($iorbase);
  75 exit $status;