TAO/tests/RTCORBA/Persistent_IOR/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 my $server = PerlACE::TestTarget::create_target (1) || die "Create target 1 failed\n";
  11 my $client = PerlACE::TestTarget::create_target (2) || die "Create target 2 failed\n";
  12
  13 $status = 0;
  14
  15 $iiop_port = 27532;
  16 $tp_iiop_port = 27533;
  17
  18 $extra_server_args = "-d 1 -ORBEndpoint iiop://1.2\@:$iiop_port -ORBLaneEndpoint 2:0 iiop://1.2\@:$tp_iiop_port";
  19
  20 @iorfiles =
  21     (
  22      "not_used_ior_1",
  23      "not_used_ior_2",
  24      "persistent_ior",
  25      "transient_ior",
  26      "tp_persistent_ior",
  27      );
  28
  29 @configurations =
  30     ({
  31          iorfiles => [ "persistent_ior", "tp_persistent_ior", "transient_ior" ],
  32          server => "-a ". $server->LocalFile ("tp_persistent_ior") ." -p ".
  33                           $server->LocalFile ("persistent_ior") ." -t ".
  34                           $server->LocalFile ("transient_ior") ." $extra_server_args",
  35          clients => [ "-k file://".$client->LocalFile("tp_persistent_ior"),
  36                       "-k file://".$client->LocalFile("persistent_ior"),
  37                       "-k file://".$client->LocalFile("transient_ior")." -x" ],
  38      }, {
  39          iorfiles => [ "not_used_ior_1", "not_used_ior_2", "transient_ior" ],
  40          server => "-a ". $server->LocalFile ("not_used_ior_1") ." -p ".
  41                           $server->LocalFile ("not_used_ior_2") ." -t ".
  42                           $server->LocalFile ("transient_ior") ." $extra_server_args",
  43          clients => [ "-k file://".$client->LocalFile("tp_persistent_ior"),
  44                       "-k file://".$client->LocalFile("persistent_ior"),
  45                       "-k file://".$client->LocalFile("transient_ior")." -x" ],
  46      },
  47      );
  48
  49 sub run_client
  50 {
  51     print "\nRunning client with the following args: @_\n\n";
  52
  53     $CL = $client->CreateProcess ("client", @_);
  54
  55     $CL->Spawn ();
  56
  57     $client_status = $CL->WaitKill ($client->ProcessStartWaitInterval ());
  58
  59     if ($client_status != 0) {
  60         print STDERR "ERROR: client returned $client_status\n";
  61         $status = 1;
  62         zap_server (1);
  63     }
  64 }
  65
  66 sub run_server
  67 {
  68     my @parms = @_;
  69     my $args = $parms[0];
  70     my $iorfiles = $parms[1];
  71
  72     print "\nRunning server with the following args: $args\n\n";
  73
  74     $SV = $server->CreateProcess ("server", $args);
  75     $SV->Spawn ();
  76
  77     for $file (@$iorfiles) {
  78         if ($server->WaitForFileTimed ($file,
  79                                       $server->ProcessStartWaitInterval ()) == -1) {
  80             print STDERR "ERROR: cannot find ior file: $file\n";
  81             $status = 1;
  82             zap_server (1);
  83         }
  84     }
  85 }
  86
  87 sub zap_server
  88 {
  89     $server_status = $SV->WaitKill ($server->ProcessStopWaitInterval ());
  90
  91     if ($server_status != 0) {
  92         print STDERR "ERROR: server returned $server_status\n";
  93         $status = 1;
  94     }
  95
  96     if ($_[0]) {
  97         for $file (@iorfiles) {
  98             $server->DeleteFile ($file);
  99         }
 100
 101         exit $status;
 102     }
 103 }
 104
 105 for $file (@iorfiles) {
 106     $server->DeleteFile ($file);
 107     $client->DeleteFile ($file);
 108 }
 109
 110 for $test (@configurations) {
 111     print STDERR "\n******************************************************\n";
 112
 113     run_server ($test->{server}, $test->{iorfiles});
 114
 115     my $clients = $test->{clients};
 116     for $args (@$clients) {
 117         run_client ($args);
 118     }
 119
 120     zap_server (0);
 121 }
 122
 123 for $file (@iorfiles) {
 124     $server->DeleteFile ($file);
 125     $client->DeleteFile ($file);
 126 }
 127
 128 exit $status;