blob: b2d30bbade308d86c545f7d02413ff3bcf2ce9de (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
|
eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}'
& eval 'exec perl -S $0 $argv:q'
if 0;
# $Id$
# -*- perl -*-
# This is a Perl script that runs some Naming Service tests.
# It runs all the tests that will run with min CORBA.
# It starts all the servers and clients as necessary.
use strict;
use lib '../../../bin';
use PerlACE::Run_Test;
# Variables for command-line arguments to client and server
# executables.
my $iorfile = PerlACE::LocalFile ("ns.ior");
my $NS = new PerlACE::Process ("../../orbsvcs/Naming_Service/Naming_Service");
my $CL = new PerlACE::Process ("../../orbsvcs/tests/Simple_Naming/client");
my $LS = new PerlACE::Process ("nslist");
my $AD = new PerlACE::Process ("nsadd");
my $status = 0;
sub name_server
{
$NS->Arguments("-o $iorfile -m 0 @_");
unlink $iorfile;
my $ret = $NS->Spawn ();
if ($ret != 0) {
print STDERR "ERROR: NameService spawn returned: $ret\n";
exit 1;
}
if (PerlACE::waitforfile_timed ($iorfile, 5) == -1) {
print STDERR "ERROR: cannot find IOR file <$iorfile>\n";
$NS->Kill ();
exit 1;
}
}
sub client
{
$CL->Arguments("@_" . " ");
my $ret = $CL->SpawnWaitKill (60);
if ($ret != 0) {
print STDERR "ERROR: client returned $ret\n";
$status = 1;
}
}
sub nslist
{
$LS->Arguments("-ORBInitRef NameService=file://$iorfile @_");
my $ret = $LS->SpawnWaitKill (60);
if ($ret != 0) {
print STDERR "ERROR: nslist returned $ret\n";
$status = 1;
}
}
sub nsadd
{
$AD->Arguments("-ORBInitRef NameService=file://$iorfile @_");
my $ret = $AD->SpawnWaitKill (60);
if ($ret != 0) {
print STDERR "ERROR: nsadd returned $ret\n";
$status = 1;
}
}
name_server ();
client ("-ORBInitRef NameService=file://$iorfile", "-t");
print STDOUT "nslist of starting NS content\n";
nslist ();
print STDOUT "nsadd of a new context at level 2\n";
nsadd ("--newcontext --name level1_context/new_lvl2_context");
print STDOUT "nsadd of a new context at level 4\n";
nsadd ("--newcontext --name level1_context/new_lvl2_context/autoadded_lvl3/new_lvl4_context");
print STDOUT "nsadd of a new object at level 4\n";
nsadd ("--ior file://ns.ior --name level1_context/new_lvl2_context/autoadded_lvl3/new_lvl4_context/new_obj");
print STDOUT "nslist of ending NS content\n";
nslist ();
$NS->TerminateWaitKill (5);
unlink $iorfile;
exit $status;
|
