TAO/orbsvcs/tests/Simple_Naming/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 runs some Naming Service tests.
   8 # It runs all the tests that will 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 use Cwd;
  14
  15 ## Save the starting directory
  16 $status = 0;
  17 $multicast = '224.9.9.2';
  18 $startdir = getcwd();
  19
  20 $quiet = 0;
  21 $skip_mmap = 0;
  22 $mt_only = 0;
  23
  24 foreach $i (@ARGV) {
  25     if ($i eq '-q') {
  26         $quiet = 1;
  27     }
  28     elsif ($i eq '-nommap') {
  29         $skip_mmap = 1;
  30     }
  31     elsif ($i eq '-mtonly') {
  32         $mt_only = 1;
  33     }
  34 }
  35
  36 my $test = PerlACE::TestTarget::create_target (1) || die "Create target 1 failed\n";
  37
  38 # Variables for command-line arguments to client and server
  39 # executables.
  40 $ns_multicast_port = 10001 + $test->RandomPort();
  41 $ns_orb_port = 12000 + $test->RandomPort();
  42
  43 $iorfile = "ns.ior";
  44 $persistent_ior_file = "pns.ior";
  45 $persistent_log_file = "test_log";
  46
  47 $data_file = "test_run.data";
  48
  49 ## Allow the user to determine where the persistent file will be located
  50 ## just in case the current directory is not suitable for locking.
  51 ## We can't change the name of the persistent file because that is not
  52 ## sufficient to work around locking problems for Tru64 when the current
  53 ## directory is NFS mounted from a system that does not properly support
  54 ## locking.
  55 foreach my $possible ($ENV{TMPDIR}, $ENV{TEMP}, $ENV{TMP}) {
  56     if (defined $possible && -d $possible) {
  57       if (chdir($possible)) {
  58         last;
  59       }
  60     }
  61 }
  62
  63 $test_log = $test->LocalFile ($data_file);
  64 $test->DeleteFile ($data_file);
  65
  66 #Files which used by test
  67 my $test_iorfile = $test->LocalFile ($iorfile);
  68 my $test_persistent_log_file = $test->LocalFile ($persistent_log_file);
  69 my $test_persistent_ior_file = $test->LocalFile ($persistent_ior_file);
  70
  71 $test->DeleteFile($persistent_ior_file);
  72 $test->DeleteFile($iorfile);
  73 $test->DeleteFile($persistent_log_file);
  74
  75 sub name_server
  76 {
  77     my $args = "-ORBMulticastDiscoveryEndpoint $multicast:$ns_multicast_port -o $test_iorfile -m 1 @_";
  78     my $prog = "$ENV{TAO_ROOT}/orbsvcs/Naming_Service/tao_cosnaming";
  79
  80     $SV = $test->CreateProcess ("$prog", "$args");
  81
  82     $test->DeleteFile($iorfile);
  83
  84     $SV->Spawn ();
  85
  86     if ($test->WaitForFileTimed ($iorfile,
  87                                $test->ProcessStartWaitInterval()) == -1) {
  88         print STDERR "ERROR: cannot find file <$test_iorfile>\n";
  89         $SV->Kill (); $SV->TimedWait (1);
  90         exit 1;
  91     }
  92
  93     sleep(1);
  94 }
  95
  96 sub client
  97 {
  98     my $args = "@_"." ";
  99     my $prog = "$ENV{TAO_ROOT}/orbsvcs/tests/Simple_Naming/client";
 100
 101     $CL = $test->CreateProcess ("$prog", "$args");
 102
 103     $client_status = $CL->SpawnWaitKill ($test->ProcessStartWaitInterval() + 45);
 104
 105     if ($client_status != 0) {
 106         print STDERR "ERROR: client returned $client_status\n";
 107         $status = 1;
 108     }
 109
 110 }
 111
 112 ## The options below have been reordered due to a
 113 ## initialization problem (within the Naming_Service)
 114 ## that has only been seen on Windows XP.
 115
 116 sub common_tests
 117 {
 118     # Options for all simple tests recognized by the 'client' program.
 119     @opts = ("-s -ORBInitRef NameService=file://$test_iorfile",
 120              "-p $test_persistent_ior_file -ORBInitRef NameService=file://$test_iorfile",
 121              "-s -ORBInitRef NameService=mcast://$multicast:$ns_multicast_port\::/NameService",
 122              "-t -ORBInitRef NameService=file://$test_iorfile",
 123              "-i -ORBInitRef NameService=file://$test_iorfile",
 124              "-e -ORBInitRef NameService=file://$test_iorfile",
 125              "-y -ORBInitRef NameService=file://$test_iorfile",
 126              "-c file://$test_persistent_ior_file -ORBInitRef NameService=file://$test_iorfile",
 127         );
 128
 129     $hostname = $test->HostName ();
 130
 131     @server_opts = ("-t 30",
 132                     "-ORBEndpoint iiop://$hostname:$ns_orb_port -f $test_persistent_log_file",
 133                     "", "", "", "", "",
 134                     "-ORBEndpoint iiop://$hostname:$ns_orb_port -f $test_persistent_log_file",
 135         );
 136
 137     @comments = ("Simple Test: \n",
 138                  "mmap() Persistent Test (Part 1): \n",
 139                  "Simple Test (using multicast to locate the server): \n",
 140                  "Tree Test: \n",
 141                  "Iterator Test: \n",
 142                  "Exceptions Test: \n",
 143                  "Destroy Test: \n",
 144                  "mmap() Persistent Test (Part 2): \n",
 145         );
 146
 147     $test_number = 0;
 148
 149     print "INFO: Running the test in ", getcwd(), "\n";
 150
 151     # Run server and client for each of the tests.  Client uses ior in a
 152     # file to bootstrap to the server.
 153     foreach $o (@opts) {
 154         if (index($comments[$test_number],"mmap") != -1 && $skip_mmap == 1) {
 155             print STDERR "\n *** skipping ".$comments[$test_number];
 156         }
 157         else {
 158             name_server ($server_opts[$test_number]);
 159             print STDERR "\n          ".$comments[$test_number];
 160             client ($o);
 161             $SV->Kill ();
 162         }
 163         ## For some reason, only on Windows XP, we need to
 164         ## wait before starting another tao_cosnaming when
 165         ## the mmap persistence option is used
 166         if ($^O eq "MSWin32") {
 167             sleep(1);
 168         }
 169         $test_number++;
 170     }
 171
 172     $test->DeleteFile($persistent_ior_file);
 173     $test->DeleteFile($persistent_log_file);
 174     $test->DeleteFile($iorfile);
 175
 176 }
 177
 178 sub mt_test ()
 179 {
 180     # Now run the multithreaded test, sending output to the file.
 181     print STDERR "\n          Multithreaded Test:\n";
 182     $test->DeleteFile ($data_file);
 183
 184     name_server ("");
 185     client ("-ORBInitRef NameService=file://$test_iorfile -ORBLogFile $test_log", "-m15");
 186
 187     $SV->Kill ();
 188
 189     $errors = system ("perl $startdir/process-m-output.pl $test_log 15") >> 8;
 190
 191     if ($errors > 0) {
 192         $status = 1;
 193
 194         if (!$quiet) {
 195             print STDERR "Errors Detected, printing output\n";
 196             if (open (DATA, "<$test_log")) {
 197                 print STDERR "================================= Begin\n";
 198                 print STDERR <DATA>;
 199                 print STDERR "================================= End\n";
 200                 close (DATA);
 201             }
 202             else {
 203                 print STDERR "ERROR: Could not open $test_log\n";
 204             }
 205             $test->DeleteFile ($data_file);
 206         }
 207     }
 208
 209     $test->DeleteFile($iorfile);
 210 }
 211
 212 ##############################################################################
 213
 214
 215 common_tests () if (!$mt_only);
 216 mt_test ();
 217 exit $status;