TAO/tests/LongUpcalls/run_test.pl

   1 eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}'
   2      & eval 'exec perl -S $0 $argv:q'
   3      if 0;
   4
   5 # -*- perl -*-
   6
   7 use lib "$ENV{ACE_ROOT}/bin";
   8 use PerlACE::TestTarget;
   9
  10 $status = 0;
  11 $debug_level = '0';
  12
  13 foreach $i (@ARGV) {
  14     if ($i eq '-debug') {
  15         $debug_level = '10';
  16     }
  17 }
  18
  19 my $server = PerlACE::TestTarget::create_target (1) || die "Create target 1 failed\n";
  20 my $client = PerlACE::TestTarget::create_target (2) || die "Create target 2 failed\n";
  21
  22 my $iorbase = "server.ior";
  23 my $server_iorfile = $server->LocalFile ($iorbase);
  24 my $client_iorfile = $client->LocalFile ($iorbase);
  25 $server->DeleteFile($iorbase);
  26 $client->DeleteFile($iorbase);
  27
  28 my $svcconf = "svc$PerlACE::svcconf_ext";
  29 my $server_svcfile = $server->LocalFile ($svcconf);
  30 my $client_svcfile = $client->LocalFile ($svcconf);
  31
  32 if ($client->PutFile ($svcconf) == -1) {
  33     print STDERR "ERROR: cannot set file <$client_svcfile>\n";
  34     exit 1;
  35 }
  36 if ($server->PutFile ($svcconf) == -1) {
  37     print STDERR "ERROR: cannot set file <$server_svcfile>\n";
  38     exit 1;
  39 }
  40
  41
  42 print STDERR "==== Server upcall waits for operations on other threads\n";
  43
  44 $SV = $server->CreateProcess ("blocking_server",
  45                               "-ORBdebuglevel $debug_level ".
  46                               "-ORBSvcConf $server_svcfile -o $server_iorfile");
  47 $CL = $client->CreateProcess ("blocking_client",
  48                               "-ORBSvcConf $client_svcfile ".
  49                               "-k file://$client_iorfile");
  50
  51 $server_status = $SV->Spawn ();
  52
  53 if ($server_status != 0) {
  54     print STDERR "ERROR: server returned $server_status\n";
  55     exit 1;
  56 }
  57
  58 if ($server->WaitForFileTimed ($iorbase,
  59                                $server->ProcessStartWaitInterval()) == -1) {
  60     print STDERR "ERROR: cannot find file <$server_iorfile>\n";
  61     $SV->Kill (); $SV->TimedWait (1);
  62     exit 1;
  63 }
  64
  65 if ($server->GetFile ($iorbase) == -1) {
  66     print STDERR "ERROR: cannot retrieve file <$server_iorfile>\n";
  67     $SV->Kill (); $SV->TimedWait (1);
  68     exit 1;
  69 }
  70 if ($client->PutFile ($iorbase) == -1) {
  71     print STDERR "ERROR: cannot set file <$client_iorfile>\n";
  72     $SV->Kill (); $SV->TimedWait (1);
  73     exit 1;
  74 }
  75
  76 $client_status = $CL->SpawnWaitKill ($client->ProcessStartWaitInterval() + 45);
  77
  78 if ($client_status != 0) {
  79     print STDERR "ERROR: client returned $client_status\n";
  80     $status = 1;
  81 }
  82
  83 $server_status = $SV->WaitKill ($server->ProcessStopWaitInterval());
  84
  85 if ($server_status != 0) {
  86     print STDERR "ERROR: server returned $server_status\n";
  87     $status = 1;
  88 }
  89
  90 $server->DeleteFile($iorbase);
  91 $client->DeleteFile($iorbase);
  92
  93 print STDERR "==== Server upcall waits for AMI operations on other threads\n";
  94
  95 $SV->Executable ("ami_server");
  96 $SV->Arguments ("-ORBdebuglevel $debug_level ".
  97                 "-ORBSvcConf $server_svcfile -o $server_iorfile");
  98 $CL->Arguments ("-ORBSvcConf $client_svcfile ".
  99                 "-k file://$client_iorfile");
 100
 101 $server_status = $SV->Spawn ();
 102
 103 if ($server_status != 0) {
 104     print STDERR "ERROR: server returned $server_status\n";
 105     exit 1;
 106 }
 107
 108 if ($server->WaitForFileTimed ($iorbase,
 109                                $server->ProcessStartWaitInterval()) == -1) {
 110     print STDERR "ERROR: cannot find file <$server_iorfile>\n";
 111     $SV->Kill (); $SV->TimedWait (1);
 112     exit 1;
 113 }
 114
 115 if ($server->GetFile ($iorbase) == -1) {
 116     print STDERR "ERROR: cannot retrieve file <$server_iorfile>\n";
 117     $SV->Kill (); $SV->TimedWait (1);
 118     exit 1;
 119 }
 120 if ($client->PutFile ($iorbase) == -1) {
 121     print STDERR "ERROR: cannot set file <$client_iorfile>\n";
 122     $SV->Kill (); $SV->TimedWait (1);
 123     exit 1;
 124 }
 125
 126 $client_status = $CL->SpawnWaitKill ($client->ProcessStartWaitInterval() + 45);
 127
 128 if ($client_status != 0) {
 129     print STDERR "ERROR: client returned $client_status\n";
 130     $status = 1;
 131 }
 132
 133 $server_status = $SV->WaitKill ($server->ProcessStopWaitInterval());
 134
 135 if ($server_status != 0) {
 136     print STDERR "ERROR: server returned $server_status\n";
 137     $status = 1;
 138 }
 139
 140 $server->DeleteFile($iorbase);
 141 $client->DeleteFile($iorbase);
 142
 143 print STDERR "==== AMI Client, Server upcall waits AMI operations\n";
 144
 145 $SV->Arguments ("-ORBdebuglevel $debug_level ".
 146                 "-ORBSvcConf $server_svcfile -o $server_iorfile");
 147 $CL->Executable ("ami_client");
 148 $CL->Arguments ("-ORBSvcConf $client_svcfile ".
 149                 "-k file://$client_iorfile");
 150
 151 $server_status = $SV->Spawn ();
 152
 153 if ($server_status != 0) {
 154     print STDERR "ERROR: server returned $server_status\n";
 155     exit 1;
 156 }
 157
 158 if ($server->WaitForFileTimed ($iorbase,
 159                                $server->ProcessStartWaitInterval()) == -1) {
 160     print STDERR "ERROR: cannot find file <$server_iorfile>\n";
 161     $SV->Kill (); $SV->TimedWait (1);
 162     exit 1;
 163 }
 164
 165 if ($server->GetFile ($iorbase) == -1) {
 166     print STDERR "ERROR: cannot retrieve file <$server_iorfile>\n";
 167     $SV->Kill (); $SV->TimedWait (1);
 168     exit 1;
 169 }
 170 if ($client->PutFile ($iorbase) == -1) {
 171     print STDERR "ERROR: cannot set file <$client_iorfile>\n";
 172     $SV->Kill (); $SV->TimedWait (1);
 173     exit 1;
 174 }
 175
 176 $client_status = $CL->SpawnWaitKill ($client->ProcessStartWaitInterval() + 45);
 177
 178 if ($client_status != 0) {
 179     print STDERR "ERROR: client returned $client_status\n";
 180     $status = 1;
 181 }
 182
 183 $server_status = $SV->WaitKill ($server->ProcessStopWaitInterval());
 184
 185 if ($server_status != 0) {
 186     print STDERR "ERROR: server returned $server_status\n";
 187     $status = 1;
 188 }
 189
 190 $server->DeleteFile($iorbase);
 191 $client->DeleteFile($iorbase);
 192
 193 print STDERR "==== AMI Client, Server upcall waits for operations on other threads\n";
 194
 195 $SV->Executable ("blocking_server");
 196 $SV->Arguments ("-ORBdebuglevel $debug_level ".
 197                 "-ORBSvcConf $server_svcfile -o $server_iorfile");
 198 $CL->Arguments ("-ORBSvcConf $client_svcfile ".
 199                 "-k file://$client_iorfile");
 200
 201 $server_status = $SV->Spawn ();
 202
 203 if ($server_status != 0) {
 204     print STDERR "ERROR: server returned $server_status\n";
 205     exit 1;
 206 }
 207
 208 if ($server->WaitForFileTimed ($iorbase,
 209                                $server->ProcessStartWaitInterval()) == -1) {
 210     print STDERR "ERROR: cannot find file <$server_iorfile>\n";
 211     $SV->Kill (); $SV->TimedWait (1);
 212     exit 1;
 213 }
 214
 215 if ($server->GetFile ($iorbase) == -1) {
 216     print STDERR "ERROR: cannot retrieve file <$server_iorfile>\n";
 217     $SV->Kill (); $SV->TimedWait (1);
 218     exit 1;
 219 }
 220 if ($client->PutFile ($iorbase) == -1) {
 221     print STDERR "ERROR: cannot set file <$client_iorfile>\n";
 222     $SV->Kill (); $SV->TimedWait (1);
 223     exit 1;
 224 }
 225
 226 $client_status = $CL->SpawnWaitKill ($client->ProcessStartWaitInterval() + 45);
 227
 228 if ($client_status != 0) {
 229     print STDERR "ERROR: client returned $client_status\n";
 230     $status = 1;
 231 }
 232
 233 $server_status = $SV->WaitKill ($server->ProcessStopWaitInterval());
 234
 235 if ($server_status != 0) {
 236     print STDERR "ERROR: server returned $server_status\n";
 237     $status = 1;
 238 }
 239
 240 $server->DeleteFile($iorbase);
 241 $client->DeleteFile($iorbase);
 242
 243 exit $status;