1 eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}'
2 & eval 'exec perl -S $0 $argv:q'
7 use lib
"$ENV{ACE_ROOT}/bin";
8 use PerlACE
::TestTarget
;
17 } elsif ($i eq '-quick') {
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;
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";
56 if ($client->PutFile ($blocked_conf) == -1) {
57 print STDERR
"ERROR: cannot set file <$client_blocked_conf>\n";
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";
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);
84 if ($server->GetFile ($iorbase) == -1) {
85 print STDERR
"ERROR: cannot retrieve file <$server_iorfile>\n";
86 $SV->Kill (); $SV->TimedWait (1);
89 if ($client->PutFile ($iorbase) == -1) {
90 print STDERR
"ERROR: cannot set file <$client_iorfile>\n";
91 $SV->Kill (); $SV->TimedWait (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);
105 print "\nLF wait strategy, corbaloc test\n";
107 $CL->Arguments ("-ORBUseSharedProfile 1 -ORBuseParallelConnects 1 ".
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);
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);
129 print "\nBlocked wait strategy test\n";
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);
145 print "\nNo parallel connect test\n";
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);
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);
171 $server_status = $SV->WaitKill ($server->ProcessStopWaitInterval());
173 if ($server_status != 0) {
174 print STDERR
"ERROR: server returned $server_status\n";
178 $server->DeleteFile($iorbase);
179 $client->DeleteFile($iorbase);