TAO/utils/nslist/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
  14 my $status = 0;
  15
  16 my $server1 = PerlACE::TestTarget::create_target (1) || die "Create target 1 failed\n";
  17 my $server2 = PerlACE::TestTarget::create_target (2) || die "Create target 2 failed\n";
  18 my $server3 = PerlACE::TestTarget::create_target (3) || die "Create target 3 failed\n";
  19 my $server4 = PerlACE::TestTarget::create_target (4) || die "Create target 4 failed\n";
  20 my $client = PerlACE::TestTarget::create_target (5) || die "Create target 5 failed\n";
  21
  22 # Variables for command-line arguments to client and server
  23 # executables.
  24 my $naming_ior = "ns.ior";
  25
  26 my $server1_naming_ior = $server1->LocalFile ($naming_ior);
  27 my $server2_naming_ior = $server2->LocalFile ($naming_ior);
  28 my $server3_naming_ior = $server3->LocalFile ($naming_ior);
  29 my $server4_naming_ior = $server4->LocalFile ($naming_ior);
  30 my $client_naming_ior = $client->LocalFile ($naming_ior);
  31
  32 $server1->DeleteFile ($naming_ior);
  33 $server2->DeleteFile ($naming_ior);
  34 $server3->DeleteFile ($naming_ior);
  35 $server4->DeleteFile ($naming_ior);
  36 $client->DeleteFile ($naming_ior);
  37
  38
  39 $NS = $server1->CreateProcess ("$ENV{TAO_ROOT}/orbsvcs/Naming_Service/tao_cosnaming", "");
  40 $LS = $server2->CreateProcess ("$ENV{ACE_ROOT}/bin/tao_nslist", "");
  41 $AD = $server3->CreateProcess ("$ENV{ACE_ROOT}/bin/tao_nsadd", "");
  42 $DL = $server4->CreateProcess ("$ENV{ACE_ROOT}/bin/tao_nsdel", "");
  43 $CL = $client->CreateProcess ("$ENV{TAO_ROOT}/orbsvcs/tests/Simple_Naming/client", "");
  44
  45 # We want the nslist and nsadd executables to be found exactly in the path
  46 # given, without being modified by the value of -ExeSubDir.
  47 # So, we tell their Process objects to ignore the setting of -ExeSubDir.
  48 $LS->IgnoreExeSubDir (1);
  49 $AD->IgnoreExeSubDir (1);
  50 $DL->IgnoreExeSubDir (1);
  51
  52 print STDOUT "Executable for nslist is " . $LS->Executable () . "\n";
  53
  54 sub name_server
  55 {
  56     $NS->Arguments("-o $server1_naming_ior -m 0 @_");
  57
  58     $server1->DeleteFile ($naming_ior);
  59     $server2->DeleteFile ($naming_ior);
  60     $server3->DeleteFile ($naming_ior);
  61     $server4->DeleteFile ($naming_ior);
  62     $client->DeleteFile ($naming_ior);
  63
  64     my $ret = $NS->Spawn ();
  65     if ($ret != 0) {
  66         print STDERR "ERROR: NameService spawn returned: $ret\n";
  67         exit 1;
  68     }
  69
  70     if ($server1->WaitForFileTimed ($naming_ior,
  71                                $server1->ProcessStartWaitInterval()) == -1) {
  72         print STDERR "ERROR: cannot find file <$naming_ior>\n";
  73         $NS->Kill (); $NS->TimedWait (1);
  74         exit 1;
  75     }
  76
  77     if ($server1->GetFile ($naming_ior) == -1) {
  78         print STDERR "ERROR: cannot retrieve file <$server1_naming_ior>\n";
  79         $SV->Kill (); $SV->TimedWait (1);
  80         exit 1;
  81     }
  82     if ($server2->PutFile ($naming_ior) == -1) {
  83         print STDERR "ERROR: cannot set file <$server2_naming_ior>\n";
  84         $SV->Kill (); $SV->TimedWait (1);
  85         exit 1;
  86     }
  87     if ($server3->PutFile ($naming_ior) == -1) {
  88         print STDERR "ERROR: cannot set file <$server3_naming_ior>\n";
  89         $SV->Kill (); $SV->TimedWait (1);
  90         exit 1;
  91     }
  92     if ($server4->PutFile ($naming_ior) == -1) {
  93         print STDERR "ERROR: cannot set file <$server4_naming_ior>\n";
  94         $SV->Kill (); $SV->TimedWait (1);
  95         exit 1;
  96     }
  97     if ($client->PutFile ($naming_ior) == -1) {
  98         print STDERR "ERROR: cannot set file <$client_naming_ior>\n";
  99         $SV->Kill (); $SV->TimedWait (1);
 100         exit 1;
 101     }
 102 }
 103
 104 sub client
 105 {
 106     $CL->Arguments("@_" . " ");
 107     my $ret = $CL->SpawnWaitKill ($client->ProcessStartWaitInterval() + 45);
 108     if ($ret != 0) {
 109         print STDERR "ERROR: client returned $ret\n";
 110         $status = 1;
 111     }
 112 }
 113
 114 sub nslist
 115 {
 116     $LS->Arguments("-ORBInitRef NameService=file://$server2_naming_ior @_");
 117     my $ret = $LS->SpawnWaitKill ($server2->ProcessStartWaitInterval() + 45);
 118     if ($ret != 0) {
 119         print STDERR "ERROR: nslist returned $ret\n";
 120         $status = 1;
 121     }
 122 }
 123
 124 sub nsadd
 125 {
 126     $AD->Arguments("-ORBInitRef NameService=file://$server3_naming_ior @_");
 127     my $ret = $AD->SpawnWaitKill ($server3->ProcessStartWaitInterval() + 45);
 128     if ($ret != 0) {
 129         print STDERR "ERROR: nsadd returned $ret\n";
 130         $status = 1;
 131     }
 132 }
 133
 134 sub nsdel
 135 {
 136     $DL->Arguments("-ORBInitRef NameService=file://$server4_naming_ior @_");
 137     my $ret = $DL->SpawnWaitKill ($server4->ProcessStartWaitInterval() + 45);
 138     if ($ret != 0) {
 139         print STDERR "ERROR: nsdel returned $ret\n";
 140         $status = 1;
 141     }
 142 }
 143
 144 name_server ();
 145
 146 print STDOUT "nslist of starting NS content\n";
 147 nslist ();
 148
 149 client ("-ORBInitRef NameService=file://$client_naming_ior", "-t");
 150
 151 print STDOUT "nslist of NS content after client use\n";
 152 nslist ();
 153
 154 print STDOUT "nsadd of a new context at level 2\n";
 155 nsadd ("--newcontext --name level1_context/new_lvl2_context");
 156
 157 print STDOUT "nsadd of a new context at level 4\n";
 158 nsadd ("--newcontext --name level1_context/new_lvl2_context/autoadded_lvl3/new_lvl4_context");
 159
 160 print STDOUT "nsadd of a new object at level 4\n";
 161 nsadd ("--ior file://ns.ior --name level1_context/new_lvl2_context/autoadded_lvl3/new_lvl4_context/new_obj");
 162
 163 print STDOUT "nslist after adding NS content\n";
 164 nslist ();
 165
 166 print STDOUT "nsdel of the object at level 4\n";
 167 print STDOUT "Expected to warn about possibly orphaned naming context.\n";
 168 nsdel ("--name level1_context/new_lvl2_context/autoadded_lvl3/new_lvl4_context/new_obj");
 169
 170 print STDOUT "nsdel of the naming context new_lvl4_context using --destroy\n";
 171 nsdel ("--name level1_context/new_lvl2_context/autoadded_lvl3/new_lvl4_context --destroy");
 172
 173 print STDOUT "nslist of ending NS content\n";
 174 nslist ();
 175
 176 $NS->TerminateWaitKill ($server1->ProcessStopWaitInterval());
 177
 178 $server1->DeleteFile ($naming_ior);
 179 $server2->DeleteFile ($naming_ior);
 180 $server3->DeleteFile ($naming_ior);
 181 $server4->DeleteFile ($naming_ior);
 182 $client->DeleteFile ($naming_ior);
 183
 184 exit $status;