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
;
10 my $server = PerlACE
::TestTarget
::create_target
(1) || die "Create target 1 failed\n";
11 my $client = PerlACE
::TestTarget
::create_target
(2) || die "Create target 2 failed\n";
13 $server->AddLibPath ('../libs/IBM1047_ISO8859/.');
14 $client->AddLibPath ('../libs/IBM1047_ISO8859/.');
15 $server->AddLibPath ('../libs/UCS4_UTF16/.');
16 $client->AddLibPath ('../libs/UCS4_UTF16/.');
18 my $iorbase = "server.ior";
19 my $server_iorfile = $server->LocalFile ($iorbase);
20 my $client_iorfile = $client->LocalFile ($iorbase);
21 $server->DeleteFile($iorbase);
22 $client->DeleteFile($iorbase);
24 my $svc_conf = "svc" . $PerlACE::svcconf_ext
;
25 my $base_conf = "cs_test" . $PerlACE::svcconf_ext
;
26 my $client_conf = $client->LocalFile ($base_conf);
27 my $server_conf = $server->LocalFile ($base_conf);
28 my $client_svc_conf = $client->LocalFile ($svc_conf);
29 my $server_svc_conf = $server->LocalFile ($svc_conf);
31 if ($server->PutFile ($base_conf) == -1) {
32 print STDERR
"ERROR: cannot set file <$server_conf>\n";
35 if ($client->PutFile ($base_conf) == -1) {
36 print STDERR
"ERROR: cannot set file <$client_conf>\n";
39 if ($server->PutFile ($svc_conf) == -1) {
40 print STDERR
"ERROR: cannot set file <$server_svc_conf>\n";
43 if ($client->PutFile ($svc_conf) == -1) {
44 print STDERR
"ERROR: cannot set file <$client_svc_conf>\n";
48 $SV = $server->CreateProcess ("server", "-o $server_iorfile -ORBDottedDecimalAddresses 1");
49 $CL = $client->CreateProcess ("client", "-k file://$client_iorfile -ORBSvcConf $client_conf");
53 print STDOUT
"Client using char translator\n\n";
55 $server_status = $SV->Spawn ();
56 if ($server_status != 0) {
57 print STDERR
"ERROR: Starting server returned $server_status\n";
60 if ($server->WaitForFileTimed ($iorbase,
61 $server->ProcessStartWaitInterval()) == -1) {
62 print STDERR
"ERROR: cannot find file <$server_iorfile>\n";
63 $SV->Kill (); $SV->TimedWait (1);
67 $client_status = $CL->SpawnWaitKill ($client->ProcessStartWaitInterval ());
68 if ($client_status != 0) {
69 print STDERR
"ERROR: client returned $client_status\n";
73 $server_status = $SV->WaitKill ($server->ProcessStopWaitInterval ());
74 if ($server_status != 0) {
75 print STDERR
"ERROR: server returned $server_status\n";
79 $server->DeleteFile($iorbase);
80 $client->DeleteFile($iorbase);
82 print STDOUT
"\nServer using char translator\n\n";
84 $SV->Arguments ("-o $server_iorfile -ORBDottedDecimalAddresses 1 -ORBSvcConf $server_conf");
85 $CL->Arguments ("-k file://$client_iorfile");
87 $server_status = $SV->Spawn ();
88 if ($server_status != 0) {
89 print STDERR
"ERROR: Starting server 2 returned $server_status\n";
92 if ($server->WaitForFileTimed ($iorbase,
93 $server->ProcessStartWaitInterval()) == -1) {
94 print STDERR
"ERROR: cannot find file <$server_iorfile>\n";
95 $SV->Kill (); $SV->TimedWait (1);
99 $client_status = $CL->SpawnWaitKill ($client->ProcessStartWaitInterval ());
100 if ($client_status != 0) {
101 print STDERR
"ERROR: client 2 returned $client_status\n";
105 $server_status = $SV->WaitKill ($server->ProcessStopWaitInterval ());
106 if ($server_status != 0) {
107 print STDERR
"ERROR: server 2 returned $server_status\n";
111 $server->DeleteFile($iorbase);
112 $client->DeleteFile($iorbase);