TAO/tests/Bug_4010_Regression/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 $cdebug_level = '0';
  13 foreach $i (@ARGV) {
  14     if ($i eq '-debug') {
  15         $debug_level = '10';
  16     }
  17     if ($i eq '-cdebug') {
  18       $cdebug_level = '10';
  19     }
  20 }
  21
  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";
  24
  25 my $iorbase = "server.ior";
  26 my $server_iorfile = $server->LocalFile ($iorbase);
  27 my $client_iorfile = $client->LocalFile ($iorbase);
  28 $server->DeleteFile($iorbase);
  29 $client->DeleteFile($iorbase);
  30
  31 my $client_conf_file = "client.conf";
  32 my $client_conf = $client->LocalFile ($client_conf_file);
  33
  34 # copy the configuation file
  35 if ($client->PutFile ($client_conf_file) == -1) {
  36     print STDERR "ERROR: cannot set file <$client_conf>\n";
  37     exit 1;
  38 }
  39
  40 $port = $server->RandomPort ();
  41 $iterations = 4;
  42 $loop_time = $server->ProcessStartWaitInterval() + $server->ProcessStopWaitInterval() + 2;
  43
  44 $SV1 = $server->CreateProcess ("server", "-ORBdebuglevel $debug_level -o $server_iorfile -ORBListenEndpoints iiop://:${port}");
  45 $SV2 = $server->CreateProcess ("server", "-ORBdebuglevel $debug_level -o $server_iorfile -ORBListenEndpoints iiop://:${port}");
  46 $CL = $client->CreateProcess ("client", "-ORBdebuglevel $cdebug_level -ORBSvcConf $client_conf -k file://$client_iorfile -t $loop_time -i $iterations");
  47
  48 $server_status = $SV1->Spawn ();
  49
  50 if ($server_status != 0) {
  51     print STDERR "ERROR: server returned $server_status\n";
  52     exit 1;
  53 }
  54
  55 if ($server->WaitForFileTimed ($iorbase,
  56                                $server->ProcessStartWaitInterval()) == -1) {
  57     print STDERR "ERROR: cannot find file <$server_iorfile>\n";
  58     $SV->Kill (); $SV->TimedWait (1);
  59     exit 1;
  60 }
  61
  62 if ($server->GetFile ($iorbase) == -1) {
  63     print STDERR "ERROR: cannot retrieve file <$server_iorfile>\n";
  64     $SV->Kill (); $SV->TimedWait (1);
  65     exit 1;
  66 }
  67 if ($client->PutFile ($iorbase) == -1) {
  68     print STDERR "ERROR: cannot set file <$client_iorfile>\n";
  69     $SV->Kill (); $SV->TimedWait (1);
  70     exit 1;
  71 }
  72
  73 $client_status = $CL->Spawn ();
  74
  75 $server_status = $SV1->WaitKill ($loop_time  + $server->ProcessStopWaitInterval());
  76
  77 if ($server_status != 0) {
  78     print STDERR "ERROR: server returned $server_status\n";
  79     $status = 1;
  80 }
  81
  82 $server->DeleteFile($iorbase);
  83 $client->DeleteFile($iorbase);
  84
  85 sleep 10;
  86 print "\nSpawning second server\n\n";
  87 $server_status = $SV2->Spawn ();
  88
  89 if ($server_status != 0) {
  90     print STDERR "ERROR: server returned $server_status\n";
  91     $status = 1;
  92 }
  93
  94 if ($server->WaitForFileTimed ($iorbase,
  95                                $server->ProcessStartWaitInterval()) == -1) {
  96     print STDERR "ERROR: cannot find file <$server_iorfile>\n";
  97     $SV->Kill (); $SV->TimedWait (1);
  98     exit 1;
  99 }
 100
 101 if ($server->GetFile ($iorbase) == -1) {
 102     print STDERR "ERROR: cannot retrieve file <$server_iorfile>\n";
 103     $SV->Kill (); $SV->TimedWait (1);
 104     exit 1;
 105 }
 106 if ($client->PutFile ($iorbase) == -1) {
 107     print STDERR "ERROR: cannot set file <$client_iorfile>\n";
 108     $SV->Kill (); $SV->TimedWait (1);
 109     exit 1;
 110 }
 111
 112 $server_status = $SV2->WaitKill ( (2 * $loop_time) + $server->ProcessStopWaitInterval());
 113
 114 if ($server_status != 0) {
 115     print STDERR "ERROR: server returned $server_status\n";
 116     $status = 1;
 117 }
 118
 119 $client_status = $CL->WaitKill ($client->ProcessStopWaitInterval());
 120
 121 if ($client_status != 0) {
 122     print STDERR "ERROR: client returned $client_status\n";
 123     $status = 1;
 124 }
 125
 126 $server->DeleteFile($iorbase);
 127 $client->DeleteFile($iorbase);
 128
 129 exit $status;
 130