TAO/orbsvcs/tests/Simple_Naming/run_test_ffp.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 runs additional Naming Service tests.
   8 # It runs all the tests that will *not* run with min CORBA.
   9 # It starts all the servers and clients as necessary.
  10
  11 use lib "$ENV{ACE_ROOT}/bin";
  12 use PerlACE::TestTarget;
  13
  14 ## Save the starting directory
  15 $status = 0;
  16 $quiet = 0;
  17
  18 # check for -q flag
  19 if ($ARGV[0] eq '-q') {
  20     $quiet = 1;
  21 }
  22
  23 my $test = PerlACE::TestTarget::create_target (1) || die "Create target 1 failed\n";
  24
  25 # Variables for command-line arguments to client and server
  26 # executables.
  27 $multicast = '224.9.9.2';
  28 $ns_multicast_port = 10001 + $test->RandomPort();
  29 $ns_orb_port = 12000 + $test->RandomPort();
  30
  31 $iorfile = "ns.ior";
  32 $persistent_ior_file = "fpns.ior";
  33
  34
  35 $iorfile = "ns.ior";
  36 $persistent_ior_file = "pns.ior";
  37
  38 my $test_iorfile = $test->LocalFile ($iorfile);
  39 my $test_persistent_ior_file = $test->LocalFile ($persistent_ior_file);
  40 my $prog = "$ENV{TAO_ROOT}/orbsvcs/Naming_Service/tao_cosnaming";
  41
  42 $test->DeleteFile($iorfile);
  43 $test->DeleteFile($persistent_ior_file);
  44
  45 sub name_server
  46 {
  47     my $args = "-o $test_iorfile @_";
  48
  49     $SV = $test->CreateProcess ("$prog", "$args");
  50
  51     $test->DeleteFile($iorfile);
  52
  53     $SV->Spawn ();
  54
  55     if ($test->WaitForFileTimed ($iorfile,
  56                                $test->ProcessStartWaitInterval()) == -1) {
  57         print STDERR "ERROR: cannot find file <$test_iorfile>\n";
  58         $SV->Kill (); $SV->TimedWait (1);
  59         exit 1;
  60     }
  61 }
  62
  63 sub client
  64 {
  65     my $args = "@_"." ";
  66     my $prog = "client";
  67
  68     $CL = $test->CreateProcess ("$prog", "$args");
  69
  70     $client_status = $CL->SpawnWaitKill ($test->ProcessStartWaitInterval() + 45);
  71
  72     if ($client_status != 0) {
  73         print STDERR "ERROR: client returned $client_status\n";
  74         $status = 1;
  75     }
  76 }
  77
  78 ## The options below have been reordered due to a
  79 ## initialization problem (within the Naming_Service)
  80 ## that has only been seen on Windows XP.
  81
  82 # Options for all simple tests recognized by the 'client' program.
  83 @opts = ("-p $test_persistent_ior_file -ORBInitRef NameService=file://$test_iorfile",
  84          "-c file://$test_persistent_ior_file -ORBInitRef NameService=file://$test_iorfile",
  85          "-l file://$test_persistent_ior_file -ORBInitRef NameService=file://$test_iorfile");
  86
  87 $hostname = $test->HostName ();
  88
  89 @server_opts = ("-ORBEndpoint iiop://$hostname:$ns_orb_port -u NameService",
  90                 "-ORBEndpoint iiop://$hostname:$ns_orb_port -u NameService",
  91                 "-ORBEndpoint iiop://$hostname:$ns_orb_port -u NameService"
  92                 );
  93
  94 @comments = ("Flat File Persistent Test (Part 1): \n",
  95              "Flat File Persistent Test (Part 2): \n",
  96              "Flat File Persistent Test (Part 3): \n");
  97
  98
  99 sub run_test
 100 {
 101     $prog = "@_";
 102
 103     $test_number = 0;
 104
 105     $test->DeleteFile($test_persistent_ior_file);
 106
 107     if ( ! -d "NameService" ) {
 108         mkdir (NameService, 0777);
 109     }
 110     else {
 111         chdir "NameService";
 112         opendir(THISDIR, ".");
 113         @allfiles = grep(!/^\.\.?$/, readdir(THISDIR));
 114         closedir(THISDIR);
 115         foreach $tmp (@allfiles){
 116             $test->DeleteFile ($tmp);
 117         }
 118         chdir "..";
 119     }
 120
 121     # Run server and client for each of the tests.  Client uses ior in a
 122     # file to bootstrap to the server.
 123     foreach $o (@opts) {
 124         name_server ($server_opts[$test_number]);
 125
 126         print STDERR "\n          ".$comments[$test_number];
 127
 128         client ($o);
 129
 130         $SV->Kill ();
 131
 132         ## For some reason, only on Windows XP, we need to
 133         ## wait before starting another tao_cosnaming when
 134         ## the mmap persistence option is used
 135         if ($^O eq "MSWin32") {
 136           sleep(1);
 137         }
 138
 139         $test_number++;
 140     }
 141
 142     chdir "NameService";
 143     opendir(THISDIR, ".");
 144     @allfiles = grep(!/^\.\.?$/, readdir(THISDIR));
 145     closedir(THISDIR);
 146     foreach $tmp (@allfiles){
 147         $test->DeleteFile ($tmp);
 148     }
 149     chdir "..";
 150     rmdir "NameService";
 151
 152     $test->DeleteFile($persistent_ior_file);
 153     $test->DeleteFile($iorfile);
 154 }
 155
 156 @server_exes = ("$ENV{TAO_ROOT}/orbsvcs/Naming_Service/tao_cosnaming",
 157                 "$ENV{TAO_ROOT}/orbsvcs/FT_Naming_Service/tao_ft_naming");
 158
 159 foreach $e (@server_exes) {
 160     print STDERR "Testing Naming Service Executable: $e\n";
 161     run_test($e);
 162     print STDERR "======================================\n";
 163 }
 164
 165 exit $status;