Revert "Use a variable on the stack to not have a temporary in the call"
[ACE_TAO.git] / TAO / tests / Parallel_Connect_Strategy / run_test.pl
blob30a0990add2b45939734c3b772b2599d5c9b7d0d
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 $status = 0;
11 $debug_level = '0';
12 $quick = 0;
14 foreach $i (@ARGV) {
15 if ($i eq '-debug') {
16 $debug_level = '10';
17 } elsif ($i eq '-quick') {
18 $quick = 1;
22 my $server = PerlACE::TestTarget::create_target (1) || die "Create target 1 failed\n";
23 my $client = PerlACE::TestTarget::create_target (2) || die "Create target 2 failed\n";
25 my $TARGETHOSTNAME = $server->HostName ();
26 my $port = $server->RandomPort ();
27 my $port1 = $port + 1;
28 my $port2 = $port + 2;
30 my @bogus_eps = (
31 "-ORBListenEndpoints iiop://$TARGETHOSTNAME:$port1/hostname_in_ior=126.0.0.123",
32 "-ORBListenEndpoints iiop://$TARGETHOSTNAME:$port2/hostname_in_ior=126.0.0.124");
33 my $corbaloc = "corbaloc:".
34 ":126.0.0.123:$port1,".
35 ":$TARGETHOSTNAME:$port,".
36 ":126.0.0.124:$port2/pcs_test";
37 my $valid_ep = "-ORBListenEndpoints iiop://$TARGETHOSTNAME:$port";
39 my $iorbase = "server.ior";
40 my $server_iorfile = $server->LocalFile ($iorbase);
41 my $client_iorfile = $client->LocalFile ($iorbase);
43 $server->DeleteFile($iorbase);
44 $client->DeleteFile($iorbase);
46 my $reactive_conf = "reactive$PerlACE::svcconf_ext";
47 my $blocked_conf = "blocked$PerlACE::svcconf_ext";
48 my $client_reactive_conf = $client->LocalFile ($reactive_conf);
49 my $client_blocked_conf = $client->LocalFile ($blocked_conf);
51 if ($client->PutFile ($reactive_conf) == -1) {
52 print STDERR "ERROR: cannot set file <$client_reactive_conf>\n";
53 exit 1;
56 if ($client->PutFile ($blocked_conf) == -1) {
57 print STDERR "ERROR: cannot set file <$client_blocked_conf>\n";
58 exit 1;
61 $SV = $server->CreateProcess ("server",
62 "-ORBdebuglevel $debug_level ".
63 "-ORBUseSharedProfile 1 ".
64 "-o $server_iorfile ".
65 "$bogus_eps[0] $valid_ep $bogus_eps[1]");
66 $CL = $client->CreateProcess ("client",
67 "-ORBuseParallelConnects 1 ".
68 "-k file://$client_iorfile");
70 $server_status = $SV->Spawn ();
72 if ($server_status != 0) {
73 print STDERR "ERROR: server returned $server_status\n";
74 exit 1;
77 if ($server->WaitForFileTimed ($iorbase,
78 $server->ProcessStartWaitInterval()) == -1) {
79 print STDERR "ERROR: cannot find file <$server_iorfile>\n";
80 $SV->Kill (); $SV->TimedWait (1);
81 exit 1;
84 if ($server->GetFile ($iorbase) == -1) {
85 print STDERR "ERROR: cannot retrieve file <$server_iorfile>\n";
86 $SV->Kill (); $SV->TimedWait (1);
87 exit 1;
89 if ($client->PutFile ($iorbase) == -1) {
90 print STDERR "ERROR: cannot set file <$client_iorfile>\n";
91 $SV->Kill (); $SV->TimedWait (1);
92 exit 1;
95 print "LF wait strategy test\n";
97 $client_status = $CL->SpawnWaitKill ($client->ProcessStartWaitInterval());
99 if ($client_status != 0) {
100 print STDERR "ERROR: client returned $client_status\n";
101 $SV->Kill (); $SV->TimedWait (1);
102 exit 1;
105 print "\nLF wait strategy, corbaloc test\n";
107 $CL->Arguments ("-ORBUseSharedProfile 1 -ORBuseParallelConnects 1 ".
108 "-k $corbaloc");
109 $client_status = $CL->SpawnWaitKill ($client->ProcessStartWaitInterval());
111 if ($client_status != 0) {
112 print STDERR "ERROR: client returned $client_status\n";
113 $SV->Kill (); $SV->TimedWait (1);
114 exit 1;
117 print "\nReactive wait strategy test\n";
119 $CL->Arguments ("-ORBSvcConf $client_reactive_conf -ORBuseParallelConnects 1 ".
120 "-k file://$client_iorfile");
121 $client_status = $CL->SpawnWaitKill ($client->ProcessStartWaitInterval());
123 if ($client_status != 0) {
124 print STDERR "ERROR: client returned $client_status\n";
125 $SV->Kill (); $SV->TimedWait (1);
126 exit 1;
129 print "\nBlocked wait strategy test\n";
131 $quick_param = '';
132 if ($quick) {
133 $quick_param = "-t";
135 $CL->Arguments ("-ORBSvcConf $client_blocked_conf -ORBuseParallelConnects 1 ".
136 "-k file://$client_iorfile $quick_param");
137 $client_status = $CL->SpawnWaitKill ($client->ProcessStartWaitInterval() + 585);
139 if ($client_status != 0) {
140 print STDERR "ERROR: client returned $client_status\n";
141 $SV->Kill (); $SV->TimedWait (1);
142 exit 1;
145 print "\nNo parallel connect test\n";
147 $quick_param = '';
148 if ($quick) {
149 $quick_param = "-t";
151 $CL->Arguments ("-ORBuseParallelConnects 0 ".
152 "-k file://$client_iorfile $quick_param");
153 $client_status = $CL->SpawnWaitKill ($client->ProcessStartWaitInterval() + 885);
155 if ($client_status != 0) {
156 print STDERR "ERROR: client returned $client_status\n";
157 $SV->Kill (); $SV->TimedWait (1);
158 exit 1;
161 $CL->Arguments ("-ORBuseParallelConnects 1 ".
162 "-k file://$client_iorfile -x");
163 $client_status = $CL->SpawnWaitKill ($client->ProcessStartWaitInterval());
165 if ($client_status != 0) {
166 print STDERR "ERROR: client returned $client_status\n";
167 $SV->Kill (); $SV->TimedWait (1);
168 exit 1;
171 $server_status = $SV->WaitKill ($server->ProcessStopWaitInterval());
173 if ($server_status != 0) {
174 print STDERR "ERROR: server returned $server_status\n";
175 $status = 1;
178 $server->DeleteFile($iorbase);
179 $client->DeleteFile($iorbase);
181 exit $status;