TAO/orbsvcs/tests/Bug_4118_Regression/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 use Cwd;
  10
  11 ## Save the starting directory
  12 $status = 0;
  13
  14 my $test = PerlACE::TestTarget::create_target (1) || die "Create target 1 failed\n";
  15
  16 # Variables for command-line arguments to client and server
  17 # executables.
  18 $ns_orb_port = 12000 + $test->RandomPort();
  19
  20 $iorfile = "ns.ior";
  21 $persistence_dir = "NameService";
  22
  23 #Files which used by test
  24 my $test_iorfile = $test->LocalFile ($iorfile);
  25
  26 # clean up from a previous test run, or from this run
  27 sub cleanup
  28 {
  29     $test->DeleteFile($iorfile);
  30     if ( ! -d $persistence_dir ) {
  31         mkdir ($persistence_dir, 0777);
  32     }
  33     else {
  34         chdir $persistence_dir;
  35         opendir(THISDIR, ".");
  36         @allfiles = grep(!/^\.\.?$/, readdir(THISDIR));
  37         closedir(THISDIR);
  38         foreach $tmp (@allfiles){
  39             $test->DeleteFile ($tmp);
  40         }
  41         chdir "..";
  42     }
  43
  44 }
  45
  46 sub start_name_server
  47 {
  48     my $args = "-ORBCollocation no -ORBListenEndpoints iiop://$hostname:$ns_orb_port -o $test_iorfile -n 5 -u $persistence_dir";
  49     my $prog = "$ENV{TAO_ROOT}/orbsvcs/Naming_Service/tao_cosnaming";
  50
  51     $SV = $test->CreateProcess ("$prog", "$args");
  52     $SV->Spawn ();
  53
  54     if ($test->WaitForFileTimed ($iorfile,
  55                                $test->ProcessStartWaitInterval()) == -1) {
  56         print STDERR "ERROR: cannot find file <$test_iorfile>\n";
  57         $SV->Kill (); $SV->TimedWait (1);
  58         exit 1;
  59     }
  60 }
  61
  62 sub nsadd
  63 {
  64     my $args = "--ns file://$test_iorfile "."@_"." ";
  65     my $prog = "$ENV{ACE_ROOT}/bin/tao_nsadd";
  66
  67     $CL = $test->CreateProcess ("$prog", "$args");
  68
  69     $client_status = $CL->SpawnWaitKill ($test->ProcessStartWaitInterval());
  70
  71     if ($client_status != 0) {
  72         print STDERR "ERROR: ns_add returned $client_status\n";
  73         $status = 1;
  74     }
  75
  76 }
  77
  78 #1. use the tao_nsadd command add a cyclical reference to the root context
  79 #2. use the tao_nsadd command to add a binding that traverses the cycle
  80 #3. verify that step 2 does not hang
  81 #4. clean up old references
  82
  83 @opts = ("--name recurse --ior file://$test_iorfile --ctx",
  84          "--name recurse/recurse/recurse/dummy --ior file://$test_iorfile");
  85
  86 $hostname = $test->HostName ();
  87
  88 @comments = ("Create naming context cycle: \n",
  89              "bind reference through cycle:  \n",
  90              );
  91
  92 $test_number = 0;
  93
  94 print "INFO: Running the test in ", getcwd(), "\n";
  95
  96 cleanup ();
  97 start_name_server ();
  98
  99 foreach $o (@opts) {
 100
 101     print STDERR "$comments[$test_number]\n";
 102
 103     nsadd ($o);
 104
 105     $test_number++;
 106 }
 107
 108 $SV->Kill ();
 109
 110 cleanup ();
 111
 112 rmdir ($persistence_dir);
 113
 114 exit $status;