TAO/orbsvcs/tests/Bug_1436_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 $ifr_service = PerlACE::TestTarget::create_target (1) || die "Create target 1 failed\n";
  20 my $tao_ifr = PerlACE::TestTarget::create_target (2) || die "Create target 2 failed\n";
  21
  22 # The location of the implementation repository binaries
  23 my $ifr_bin_path = "$ENV{TAO_ROOT}/orbsvcs/IFR_Service";
  24
  25 # The location of the tao_ifr IFR utility
  26 my $tao_ifr_bin_path = "$ENV{ACE_ROOT}/bin";
  27
  28 # IOR file
  29 my $ior_file = "ifr.ior";
  30
  31 # IDL File
  32 my $idl_file = "test.idl";
  33
  34 #Log file
  35 my @result_files = ();
  36 for ($i = 0; $i < 2; $i++) {
  37     $result_files[$i] = "test_result_$i.log";
  38 }
  39
  40 #Files specification
  41 $tao_ifr_idlfile = $tao_ifr->LocalFile($idl_file);
  42 $tao_ifr_iorfile = $tao_ifr->LocalFile($ior_file);
  43
  44 $ifr_service_iorfile = $ifr_service->LocalFile($ior_file);
  45
  46 $tao_ifr->DeleteFile($ior_file);
  47 $ifr_service->DeleteFile($ior_file);
  48
  49 $ifr_service_result_file = $ifr_service->LocalFile ($result_files[0]);
  50 $tao_ifr_result_file     = $ifr_service->LocalFile ($result_files[1]);
  51 $ifr_service->DeleteFile ($result_files[0]);
  52 $tao_ifr->DeleteFile ($result_files[1]);
  53
  54 $IFRSERVICE = $ifr_service->CreateProcess("$ifr_bin_path/tao_ifr_service", "-ORBdebuglevel $debug_level ".
  55                                          "-ORBLogFile $ifr_service_result_file ".
  56                                          "-o $ifr_service_iorfile");
  57 $TAOIFR = $tao_ifr->CreateProcess("$tao_ifr_bin_path/tao_ifr", "-ORBLogFile $tao_ifr_result_file ".
  58                                          "-ORBInitRef InterfaceRepository=file://$tao_ifr_iorfile ".
  59                                          "-Cw $tao_ifr_idlfile");
  60
  61 sub analyse_results {
  62     my $result_file = $_[0];
  63
  64     if (! -r $result_file) {
  65         print STDERR "ERROR: cannot find $result_file\n";
  66         return 1;
  67     }
  68
  69     my $match = 0;
  70     open (FILE, $result_file) or return -1;
  71     while (<FILE>) {
  72         $match = /Warning - identifier spellings differ only in case:/;
  73         last if $match;
  74     }
  75     close FILE;
  76
  77     return $match ? 0 : -1;
  78 }
  79
  80 sub test_body {
  81     # Start the IFR Service to generate an IOR file for the tao_ifr to use...
  82     $ifr_status = $IFRSERVICE->Spawn ();
  83
  84     if ($ifr_status != 0) {
  85         print STDERR "ERROR: ifr_service Spawn returned $ifr_status\n";
  86         return 1;
  87     }
  88
  89     if ($ifr_service->WaitForFileTimed ($ior_file,
  90                                $ifr_service->ProcessStartWaitInterval()) == -1) {
  91         print STDERR "ERROR: cannot find file <$ifr_service_iorfile>\n";
  92         $IFRSERVICE->Kill (); $IFRSERVICE->TimedWait (1);
  93         return 1;
  94     }
  95
  96     if ($ifr_service->GetFile ($ior_file) == -1) {
  97         print STDERR "ERROR: cannot retrieve file <$ifr_service_iorfile>\n";
  98         $IFRSERVICE->Kill (); $IFRSERVICE->TimedWait (1);
  99         return 1;
 100     }
 101
 102     if ($tao_ifr->PutFile ($ior_file) == -1) {
 103         print STDERR "ERROR: cannot set file <$tao_ifr_iorfile>\n";
 104         $IFRSERVICE->Kill (); $IFRSERVICE->TimedWait (1);
 105         return 1;
 106     }
 107
 108     $tao_status = $TAOIFR->SpawnWaitKill ($tao_ifr->ProcessStartWaitInterval() + 15);
 109     if ($tao_status != 0) {
 110         print STDERR "ERROR: tao_ifr returned $tao_status\n";
 111         $status = 1;
 112     }
 113
 114     $match = 0;
 115 #    $match = analyse_results ($ifr_service_result_file); $ # this string is not currently needed
 116     $match += analyse_results ($tao_ifr_result_file);
 117
 118     # Tidy up
 119     $ifr_status = $IFRSERVICE->TerminateWaitKill ($ifr_service->ProcessStopWaitInterval());
 120     if ($ifr_status != 0) {
 121         print STDERR "ERROR: ifr_service TerminateWaitKill returned $ifr_status\n";
 122         return 1;
 123     }
 124
 125     return $match;
 126 }
 127
 128 # Run regression for bug #1436
 129 $status = test_body();
 130
 131 if ($status != 0) {
 132     print STDERR "ERROR: Regression test for Bug #1436 failed\n";
 133 }
 134 else {
 135     print "Regression test for Bug #1436 passed.\n";
 136 }
 137
 138 $tao_ifr->DeleteFile($ior_file);
 139 $ifr_service->DeleteFile($ior_file);
 140 $ifr_service->DeleteFile ($result_files[0]);
 141 $tao_ifr->DeleteFile ($result_files[1]);
 142
 143 exit $status;