blob: bd4bc793631379ce4c37e4d83e2f4c204ef28cfc (
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
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
|
eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}'
& eval 'exec perl -S $0 $argv:q'
if 0;
# -*- perl -*-
# $Id$
use lib "$ENV{ACE_ROOT}/bin";
use PerlACE::Run_Test;
# The location of the implementation repository binaries
$imr_bin_path = "../../ImplRepo_Service";
# The location of the tao_imr IMR utility
$tao_imr_bin_path = "$ENV{ACE_ROOT}/bin";
# IOR file names
$imr_ior_file = PerlACE::LocalFile("impl.ior");
$activator_ior_file = PerlACE::LocalFile("activator.ior");
$server_ior_file = PerlACE::LocalFile("server.ior");
# The players in our little drama.
$LOCATOR = new PerlACE::Process("$imr_bin_path/ImplRepo_Service");
$ACTIVATOR = new PerlACE::Process("$imr_bin_path/ImR_Activator");
$SERVER = new PerlACE::Process(PerlACE::LocalFile("server"));
$CLIENT = new PerlACE::Process(PerlACE::LocalFile("client"));
$TAO_IMR = new PerlACE::Process("$tao_imr_bin_path/tao_imr");
# Run the IMR locator on a fixed port
$port = PerlACE::uniqueid () + 10001; # This can't be 10000 for Chorus 4.0
sub test_body
{
unlink $imr_ior_file;
unlink $activator_ior_file;
unlink $server_ior_file;
# Start the IMR locator to generate an IOR file for the server to use...
$LOCATOR->Arguments("-o $imr_ior_file -ORBEndpoint iiop://:$port");
$LOCATOR->Spawn ();
if (PerlACE::waitforfile_timed ($imr_ior_file, 10) == -1)
{
print STDERR "ERROR: cannot find $imr_ior_file\n";
$LOCATOR->Kill ();
return 1;
}
# ...then shut it down so that the server will not be able to contact it
$LOCATOR->TerminateWaitKill (5);
if ($imr_locator != 0)
{
print STDERR "ERROR: IMR returned $imr_locator\n";
$status = 1;
}
# Start our server
$SERVER->Arguments("-o $server_ior_file -ORBInitRef ImplRepoService=file://$imr_ior_file -ORBUseIMR 1");
$SERVER->Spawn ();
if (PerlACE::waitforfile_timed ($server_ior_file, 10) == -1)
{
print STDERR "ERROR: cannot find $server_ior_file\n";
$ACTIVATOR->Kill ();
$LOCATOR->Kill ();
$SERVER->Kill ();
return 1;
}
# Use the client to ask the server to try and create a persitent POA
# We expect this to 'fail' as the IMR is dead
$CLIENT->Arguments("-k file://$server_ior_file");
$result = $CLIENT->SpawnWaitKill (30);
if ($result == 0)
{
print STDERR "ERROR: First create POA attempt succeeded when it shouldn't have done\n";
$SERVER->Kill ();
return 1;
}
# Now we restart the IMR locator
unlink $imr_ior_file;
$LOCATOR->Arguments("-o $imr_ior_file -ORBEndpoint iiop://:$port");
$LOCATOR->Spawn ();
if (PerlACE::waitforfile_timed ($imr_ior_file, 10) == -1)
{
print STDERR "ERROR: cannot find $imr_ior_file\n";
$LOCATOR->Kill ();
return 1;
}
# Work out the IMR activator command line.
# Use the '-a' switch if this is a regression for bug #1394, else not
if ($use_tao_imr_util != 0)
{
$activator_arguments = "-o $activator_ior_file -ORBInitRef ImplRepoService=file://$imr_ior_file";
}
else
{
$activator_arguments = "-o $activator_ior_file -a -ORBInitRef ImplRepoService=file://$imr_ior_file";
}
# Start up the activator
$ACTIVATOR->Arguments ($activator_arguments);
$ACTIVATOR->Spawn ();
if (PerlACE::waitforfile_timed ($activator_ior_file, 10) == -1)
{
print STDERR "ERROR: cannot find $activator_ior_file\n";
$ACTIVATOR->Kill ();
$LOCATOR->Kill ();
return 1;
}
## Since we have restarted the locator, we need to restart
## the server so that it can pick up the new locator IOR
unlink($server_ior_file);
$SERVER->Kill ();
$SERVER->Spawn ();
if (PerlACE::waitforfile_timed ($server_ior_file, 10) == -1)
{
print STDERR "ERROR: cannot find $server_ior_file\n";
$ACTIVATOR->Kill ();
$LOCATOR->Kill ();
$SERVER->Kill ();
return 1;
}
# If this is just a regression for bug #1395 we need to register the POA
# If it is a regression for enhancement bug #1394, we don't need to.
if ($use_tao_imr_util != 0)
{
# Add the persistent POA name to the IMR
$TAO_IMR->Arguments("add MyPoa -ORBInitRef ImplRepoService=file://$imr_ior_file");
$result = $TAO_IMR->SpawnWaitKill (30);
if ($result != 0)
{
print STDERR "ERROR: tao_imr returned $result\n";
$ACTIVATOR->Kill ();
$LOCATOR->Kill ();
return 1;
}
}
# Use the client to tell the server to attempt to create the POA again
$CLIENT->Arguments("-k file://$server_ior_file");
$result = $CLIENT->SpawnWaitKill (30);
if ($result != 0)
{
print STDERR "ERROR: Second create POA attempt failed when it should have succeeded\n";
$SERVER->Kill ();
$ACTIVATOR->Kill ();
$LOCATOR->Kill ();
return 1;
}
# Tidy up
$SERVER->TerminateWaitKill (5);
$ACTIVATOR->TerminateWaitKill (5);
$LOCATOR->TerminateWaitKill (5);
return 0;
}
# Run regression for bug #1395
$use_tao_imr_util = 1;
$test_result = test_body();
if ($test_result != 0)
{
print STDERR "ERROR: Regression test for Bug #1395 failed\n";
unlink $imr_ior_file;
unlink $activator_ior_file;
unlink $server_ior_file;
exit $test_result;
}
# Bug 1394 is an enhancement so will not be submitted until after TAO1.3.1
# Uncomment the following to activate regression after submission and ..
# Run regression for bug #1394
#$use_tao_imr_util = 0;
#$test_result = test_body();
#if ($test_result != 0)
#{
# print STDERR "ERROR: Regression test for Bug #1394 failed\n";
#}
unlink $imr_ior_file;
unlink $activator_ior_file;
unlink $server_ior_file;
exit $test_result;
|
