Changes to attempt to silence bcc64x
[ACE_TAO.git] / TAO / utils / nsgroup / run_test.pl
blob048b472453ef974a4887e46c61fc3e52992d4b85
1 eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}'
2 & eval 'exec perl -S $0 $argv:q'
3 if 0;
5 # -*- perl -*-
7 use lib "$ENV{ACE_ROOT}/bin";
8 use PerlACE::TestTarget;
10 my $status = 0;
11 my $debug_level = 0;
12 my $redirection_enabled = 0;
15 foreach $i (@ARGV) {
16 if ($i eq '-debug') {
17 $debug_level = '10';
21 #$ENV{ACE_TEST_VERBOSE} = "1";
23 my $server = PerlACE::TestTarget::create_target (1) || die "Create target 1 failed\n";
24 my $client = PerlACE::TestTarget::create_target (2) || die "Create target 2 failed\n";
26 ## The LoadManager needs to register signals with the ORB's reactor (on
27 ## Windows only) and thus can not use the TP Reactor since it doesn't
28 ## support that kind of thing. So, we swith to the Select MT Reactor.
29 my $NM_conf = $server->LocalFile ("windows" . $PerlACE::svcconf_ext);
31 my $name_mgr_iorbase = "nm.ior";
32 my $name_srv_iorbase = "ns.ior";
33 my $stdout_file = "test.out";
34 my $stderr_file = "test.err";
36 my $server_hostname = $server->HostName ();
37 my $name_mgr_iorfile = $server->LocalFile ($name_mgr_iorbase);
38 my $name_server_iorfile = $server->LocalFile ($name_srv_iorbase);
40 my $naming_mgr_client_iorfile = $client->LocalFile ($name_mgr_iorbase);
41 my $name_srv_client_iorfile = $client->LocalFile ($name_srv_iorbase);
42 my $client_stdout_file = $client->LocalFile ($stdout_file);
43 my $client_stderr_file = $client->LocalFile ($stderr_file);
45 $server->DeleteFile($name_mgr_iorbase);
46 $server->DeleteFile($name_srv_iorbase);
47 $client->DeleteFile($name_mgr_iorbase);
48 $client->DeleteFile($name_srv_iorbase);
49 $client->DeleteFile($stdout_file);
50 $client->DeleteFile($stderr_file);
52 my $DEBUG_LEVEL = "-ORBDebugLevel $debug_level";
53 my $hostname = $server->HostName ();
54 my $ns_orb_port1 = 10001 + $server->RandomPort ();
55 my $ns_endpoint1 = "iiop://$hostname:$ns_orb_port1";
57 my $DEF_REF = "-ORBDefaultInitRef corbaloc:iiop:$hostname:$ns_orb_port1";
58 #my $NM_REF = "-ORBInitRef NameService=file://$name_srv_client_iorfile";
59 #my $RM_REF = "-ORBInitRef NamingManager=file://$naming_mgr_client_iorfile";
60 my $NS_REF = "--ns file://$name_srv_client_iorfile";
61 my $LOAD_ARG = "$DEF_REF $DEBUG_LEVEL";
63 my $tao_ft_naming = "$ENV{TAO_ROOT}/orbsvcs/FT_Naming_Service/tao_ft_naming";
64 my $name_dir = "NameService";
65 my $group_dir = "Groups";
66 my $ns_args = "$DEBUG_LEVEL " .
67 "-ORBListenEndPoints $ns_endpoint1 " .
68 "-h $name_mgr_iorbase " .
69 "-o $name_srv_iorbase " .
70 "-v $group_dir " .
71 "-u $name_dir " .
72 ($^O eq 'MSWin32' ? "-ORBSvcConf $NM_conf" : '');
74 my $NM = $server->CreateProcess ($tao_ft_naming, $ns_args);
75 my $NSGROUP = $client->CreateProcess ("$ENV{ACE_ROOT}/bin/tao_nsgroup");
76 my $NSLIST = $client->CreateProcess ("$ENV{ACE_ROOT}/bin/tao_nslist");
77 my $NSADD = $client->CreateProcess ("$ENV{ACE_ROOT}/bin/tao_nsadd");
78 my $NSDEL = $client->CreateProcess ("$ENV{ACE_ROOT}/bin/tao_nsdel");
80 my $POSITIVE_TEST_RESULT = 0;
81 my $NEGATIVE_TEST_RESULT = 1;
83 sub clean_persistence_dir($$)
85 my $target = shift;
86 my $directory_name = shift;
88 chdir $directory_name;
89 opendir(THISDIR, ".");
90 @allfiles = grep(!/^\.\.?$/, readdir(THISDIR));
91 closedir(THISDIR);
92 foreach $tmp (@allfiles){
93 $target->DeleteFile ($tmp);
95 chdir "..";
98 # Make sure that the directory to use to hold the persistence data
99 # exists and is cleaned out.
100 sub init_persistence_directory($$)
102 my $target = shift;
103 my $directory_name = shift;
105 if ( ! -d $directory_name ) {
106 mkdir ($directory_name, 0777);
107 } else {
108 clean_persistence_dir ($target, $directory_name);
112 sub cat_file($)
114 my $file_name = shift;
115 if (-s $file_name ) # size of file is greater than zero
117 open TESTFILE, $file_name or die "Couldn't open file: $!";
118 my @teststring = <TESTFILE>; # read in all of the file
119 print STDERR "\n@teststring\n";
120 close TESTFILE;
124 sub redirect_output()
126 open(OLDOUT, ">&", \*STDOUT) or die "Can't dup STDOUT: $!";
127 open(OLDERR, ">&", \*STDERR) or die "Can't dup STDERR: $!";
128 open STDERR, '>', $client_stderr_file;
129 open STDOUT, '>', $client_stdout_file;
132 sub restore_output()
134 open(STDERR, ">&OLDERR") or die "Can't dup OLDERR: $!";
135 open(STDOUT, ">&OLDOUT") or die "Can't dup OLDOUT: $!";
138 sub run_client ($$)
140 my $args = shift;
141 my $expected_test_result = shift;
143 my $arglist = "$LOAD_ARG $args";
145 if ($expected_test_result != $POSITIVE_TEST_RESULT ) {
146 print STDERR "\n\n======== Running Negative Test ================\n";
147 } else {
148 print STDERR "\n\n======== Running Positive Test ================\n";
150 print STDERR "$args\n";
152 $NSGROUP->Arguments ($arglist);
154 if ($redirection_enabled) {
155 redirect_output();
158 my $client_status = $NSGROUP->SpawnWaitKill ($client->ProcessStartWaitInterval());
160 if ($redirection_enabled) {
161 restore_output();
165 if ($client_status != $expected_test_result) {
166 my $time = localtime;
167 print STDERR "ERROR: client returned $client_status at $time\n";
168 if ($redirection_enabled) {
169 cat_file($client_stderr_file);
170 cat_file($client_stdout_file);
172 $status = 1;
176 sub run_nsadd($)
178 print STDERR "\n\n======== Running tao_nsadd ================\n";
179 my $args = shift;
180 $NSADD->Arguments ($args);
182 if ($redirection_enabled) {
183 redirect_output();
186 #tao_nsadd --ns file://ns.ior --name iso --ctx
187 my $client_status = $NSADD->SpawnWaitKill ($client->ProcessStartWaitInterval());
189 if ($redirection_enabled) {
190 restore_output();
193 if ($client_status != $0) {
194 my $time = localtime;
195 print STDERR "ERROR: nsadd returned $client_status at $time\n";
196 if ($redirection_enabled) {
197 cat_file($client_stderr_file);
199 $status = 1;
203 sub run_nsdel($)
205 print STDERR "\n\n======== Running tao_nsdel ================\n";
206 my $args = shift;
207 $NSDEL->Arguments ($args);
209 if ($redirection_enabled) {
210 redirect_output();
213 #tao_nsdel --ns file://ns.ior --name iso --destroy
214 my $client_status = $NSDEL->SpawnWaitKill ($client->ProcessStartWaitInterval());
216 if ($redirection_enabled) {
217 restore_output();
220 if ($client_status != $0) {
221 my $time = localtime;
222 print STDERR "ERROR: nsdel returned $client_status at $time\n";
223 if ($redirection_enabled) {
224 cat_file($client_stderr_file);
226 $status = 1;
230 sub run_nslist($)
232 print STDERR "\n\n======== Running tao_nslist ================\n";
233 my $args = shift;
234 $NSLIST->Arguments ($args);
236 if ($redirection_enabled) {
237 redirect_output();
240 #tao_nslist --ns file://ns.ior
241 my $client_status = $NSLIST->SpawnWaitKill ($client->ProcessStartWaitInterval());
243 if ($redirection_enabled) {
244 restore_output();
247 if ($client_status != $0) {
248 my $time = localtime;
249 print STDERR "ERROR: nslist returned $client_status at $time\n";
250 if ($redirection_enabled) {
251 cat_file($client_stderr_file);
253 $status = 1;
257 sub run_clients ()
259 run_client (
260 "group_list",
261 $POSITIVE_TEST_RESULT);
263 run_client (
264 "group_create -group ieee -policy round",
265 $POSITIVE_TEST_RESULT);
267 run_client (
268 "group_create -group ieed -policy random",
269 $POSITIVE_TEST_RESULT);
271 run_client (
272 "group_create -group ieec -policy least",
273 $NEGATIVE_TEST_RESULT);
275 run_client (
276 "group_create -group ieee -policy round",
277 $NEGATIVE_TEST_RESULT);
279 run_client (
280 "group_list",
281 $POSITIVE_TEST_RESULT);
283 run_client (
284 "member_list -group ieee",
285 $POSITIVE_TEST_RESULT);
287 run_client (
288 "member_add -group ieee -location $server_hostname -ior file://$naming_mgr_client_iorfile",
289 $POSITIVE_TEST_RESULT);
291 run_client (
292 "member_list -group ieee",
293 $POSITIVE_TEST_RESULT);
295 run_nsadd("$DEF_REF"." --name iso --ctx");
297 run_nslist("$NS_REF");
299 run_client (
300 "group_unbind -name iso/ieee",
301 $NEGATIVE_TEST_RESULT);
303 run_nslist("$NS_REF");
305 run_client (
306 "group_bind -group ieee -name iso/ieee",
307 $POSITIVE_TEST_RESULT);
309 run_nslist("$NS_REF");
311 run_client (
312 "member_add -group ieee -location $server_hostname -ior file://$naming_mgr_client_iorfile",
313 $NEGATIVE_TEST_RESULT);
315 run_client (
316 "member_list -group ieee",
317 $POSITIVE_TEST_RESULT);
319 run_client (
320 "member_show -group ieee -location $server_hostname",
321 $POSITIVE_TEST_RESULT);
323 run_client (
324 "member_remove -group ieee -location $server_hostname",
325 $POSITIVE_TEST_RESULT);
327 run_client (
328 "member_list -group ieee",
329 $POSITIVE_TEST_RESULT);
331 run_client (
332 "group_remove -group ieee",
333 $POSITIVE_TEST_RESULT);
335 run_client (
336 "group_unbind -name iso/ieee",
337 $POSITIVE_TEST_RESULT);
339 run_nslist("$NS_REF");
341 run_client (
342 "group_list",
343 $POSITIVE_TEST_RESULT);
345 run_nsdel("$DEF_REF"." --name iso --destroy");
347 # Verify we can handle a non-existent ior to add to the list
348 run_nsadd("$DEF_REF --name does_not_exist --ior file://thisfiledoesnotexist");
349 run_nslist("$NS_REF");
350 run_nsdel("$DEF_REF"." --name does_not_exist");
351 run_nslist("$NS_REF");
354 run_client (
355 "-help",
356 $POSITIVE_TEST_RESULT);
359 print STDERR "\n\n======== Running tao_nsgroup Test================\n";
360 print STDERR "\n";
362 print STDERR "This test will check the methods of the tao_nsgroup\n";
363 print STDERR "\n";
365 init_persistence_directory ($server, $name_dir );
366 init_persistence_directory ($server, $group_dir );
368 ################################################################################
369 # setup END block to cleanup after exit call
370 ################################################################################
373 $server->DeleteFile($name_mgr_iorbase);
374 $server->DeleteFile($name_srv_iorbase);
375 $client->DeleteFile($name_mgr_iorbase);
376 $client->DeleteFile($name_srv_iorbase);
377 $client->DeleteFile($stdout_file);
378 $client->DeleteFile($stderr_file);
380 if ( -d $name_dir ) {
381 clean_persistence_dir ($server, $name_dir);
382 rmdir ($name_dir);
385 if ( -d $group_dir ) {
386 clean_persistence_dir ($server, $group_dir);
387 rmdir ($group_dir);
391 ################################################################################
392 ## Start tao_ft_naming Service
393 ################################################################################
395 $server_status = $NM->Spawn ();
397 if ($server_status != 0) {
398 print STDERR "ERROR: server returned $server_status\n";
399 exit 1;
402 if ($server->WaitForFileTimed ($name_mgr_iorbase,
403 $server->ProcessStartWaitInterval()) == -1) {
404 print STDERR "ERROR: cannot find file <$name_mgr_iorbase>\n";
405 $NM->Kill (); $NM->TimedWait (1);
406 exit 1;
409 print STDERR "Waiting for $name_mgr_iorbase\n";
410 if ($server->GetFile ($name_mgr_iorbase) == -1) {
411 print STDERR "ERROR: cannot retrieve file <$name_mgr_iorbase>\n";
412 $NM->Kill (); $NM->TimedWait (1);
413 exit 1;
416 if ($client->PutFile ($name_mgr_iorbase) == -1) {
417 print STDERR "ERROR: cannot set file <$naming_mgr_client_iorfile>\n";
418 $NM->Kill (); $NM->TimedWait (1);
419 exit 1;
422 run_clients();
424 print STDERR "\n\n====================================================\n";
425 print STDERR "\n";
426 $server_status = $NM->TerminateWaitKill ($server->ProcessStopWaitInterval());
428 if ($server_status != 0) {
429 print STDERR "ERROR: server returned $server_status\n";
430 $status = 1;
434 exit $status;