TAO/tests/RTCORBA/Server_Protocol/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 my $iorbase = "test.ior";
  14 my $server_iorfile = $server->LocalFile ($iorbase);
  15 my $client_iorfile = $client->LocalFile ($iorbase);
  16 $server->DeleteFile($iorbase);
  17 $client->DeleteFile($iorbase);
  18
  19 $status = 0;
  20
  21 $server_reverse_conf_base = "server_reverse$PerlACE::svcconf_ext";
  22 $server_reverse_conf = $server->LocalFile ($server_reverse_conf_base);
  23
  24 $server_iiop_uiop_conf_base = "server_iiop_uiop$PerlACE::svcconf_ext";
  25 $server_iiop_uiop_conf = $server->LocalFile ($server_iiop_uiop_conf_base);
  26
  27 # Copy configuration files to the target.
  28 if ($server->PutFile ($server_reverse_conf_base) == -1) {
  29     print STDERR "ERROR: cannot set file <$server_reverse_conf>\n";
  30     exit 1;
  31 }
  32 if ($server->PutFile ($server_iiop_uiop_conf_base) == -1) {
  33     print STDERR "ERROR: cannot set file <$server_iiop_uiop_conf>\n";
  34     exit 1;
  35 }
  36
  37 # Configurations for all tests to be run.
  38 @server_opts =
  39     ("-ORBSndSock 54321 -ORBendpoint iiop://",
  40
  41      "-ORBsvcconf $server_reverse_conf "
  42      ."-ORBEndpoint shmiop:// -ORBEndpoint uiop:// -ORBendpoint iiop://",
  43
  44      "-ORBRcvSock 12345 -ORBsvcconf $server_iiop_uiop_conf "
  45      ."-ORBEndpoint iiop:// -ORBEndpoint uiop:// "
  46      ."-p 1413566208");
  47
  48 @comments = ("* ORB Default Server Protocol Policy Test\n          "
  49              ."(TAO's default behavior without config files): \n",
  50
  51              "* ORB Default Server Protocol Policy Test\n          "
  52              ."(All TAO protocols are loaded, but in reverse order): \n",
  53
  54              "* Overriding ORB Default Server Protocol Policy in the POA\n"
  55              ."          (POA Server Protocol set to UIOP only): \n");
  56
  57
  58
  59 # UIOP only available on Unix.  Substitute with alternative tests on Windows.
  60 if ($^O eq "MSWin32" || $^O eq "VMS") {
  61     $server_iiop_shmiop_conf_base = "server_iiop_shmiop$PerlACE::svcconf_ext";
  62     $server_iiop_shmiop_conf = $server->LocalFile ($server_iiop_shmiop_conf_base);
  63
  64     $server_reverse_nt_conf_base = "server_reverse_nt$PerlACE::svcconf_ext";
  65     $server_reverse_nt_conf  = $server->LocalFile ($server_reverse_nt_conf_base);
  66
  67     # Copy the configuration files
  68     if ($server->PutFile ($server_iiop_shmiop_conf_base) == -1) {
  69         print STDERR "ERROR: cannot set file <$server_iiop_shmiop_conf>\n";
  70         exit 1;
  71     }
  72     if ($server->PutFile ($server_reverse_nt_conf_base) == -1) {
  73         print STDERR "ERROR: cannot set file <$server_reverse_nt_conf>\n";
  74         exit 1;
  75     }
  76
  77     @server_opts =
  78         ("-ORBSndSock 54321 -ORBendpoint iiop://",
  79
  80          "-ORBsvcconf $server_reverse_nt_conf "
  81          ."-ORBEndpoint shmiop:// -ORBendpoint iiop://",
  82
  83          "-ORBRcvSock 12345 -ORBsvcconf $server_iiop_shmiop_conf "
  84         ."-ORBEndpoint iiop:// -ORBEndpoint shmiop:// "
  85         ."-p 1413566210");
  86
  87     $comments[2] =
  88          "* Overriding ORB Default Server Protocol Policy in the POA\n"
  89          ."          (POA Server Protocol set to SMHIOP only): \n";
  90
  91 }
  92
  93 print STDERR "********** RTCORBA Server Protocol Policy Unit Test\n";
  94
  95 $test_number = 0;
  96
  97 $SV = $server->CreateProcess ("server");
  98
  99 $CL = $client->CreateProcess ("client");
 100
 101 foreach $o (@server_opts) {
 102     print STDERR "\n\n----------------------------------\n";
 103     print STDERR "        ".$comments[$test_number];
 104
 105     my $args = "$o -o $server_iorfile";
 106
 107     $server->DeleteFile ($iorbase);
 108
 109     $SV->Arguments ($args);
 110
 111     $SV->Spawn ();
 112
 113     if ($server->WaitForFileTimed ($iorbase,
 114                                    $server->ProcessStartWaitInterval()) == -1) {
 115         print STDERR "ERROR: cannot find file <$server_iorfile>\n";
 116         $SV->Kill (); $SV->TimedWait (1);
 117         exit 1;
 118     }
 119
 120     $CL->Arguments ("-k file://$client_iorfile -ORBdebuglevel 1");
 121
 122     $client_status = $CL->SpawnWaitKill ($client->ProcessStartWaitInterval ());
 123
 124     if ($client_status != 0) {
 125         print STDERR "ERROR: client returned $client_status\n";
 126         $status = 1;
 127     }
 128
 129     $server_status = $SV->WaitKill ($server->ProcessStopWaitInterval ());
 130
 131     if ($server_status != 0) {
 132         print STDERR "ERROR: server returned $server_status\n";
 133         $status = 1;
 134     }
 135
 136     $test_number++;
 137 }
 138
 139 $server->DeleteFile($iorbase);
 140 $client->DeleteFile($iorbase);
 141
 142 # Clean up SHMIOP files
 143 PerlACE::check_n_cleanup_files ("server_shmiop_*");
 144
 145 exit $status;