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