TAO/tests/Oneway_Buffering/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 $test_type = "-c -t -b -r";
  13
  14 foreach $i (@ARGV) {
  15     if ($i eq '-debug') {
  16         $debug_level = '10';
  17     }
  18 }
  19
  20 my $server = PerlACE::TestTarget::create_target (1) || die "Create target 1 failed\n";
  21 my $client = PerlACE::TestTarget::create_target (2) || die "Create target 2 failed\n";
  22 my $admin = PerlACE::TestTarget::create_target (3) || die "Create target 3 failed\n";
  23
  24 my $iorfile_admin = "admin.ior";
  25 my $iorfile = "server.ior";
  26
  27 #Files which used by server
  28 my $server_iorfile = $server->LocalFile ($iorfile);
  29 my $server_iorfile_admin = $server->LocalFile ($iorfile_admin);
  30 $server->DeleteFile($iorfile);
  31 $server->DeleteFile($iorfile_admin);
  32
  33 #Files which used by client
  34 my $client_iorfile = $client->LocalFile ($iorfile);
  35 my $client_iorfile_admin = $client->LocalFile ($iorfile_admin);
  36 $client->DeleteFile($iorfile);
  37 $client->DeleteFile($iorfile_admin);
  38
  39 #Files which used by admin
  40 my $admin_iorfile_admin = $admin->LocalFile ($iorfile_admin);
  41 $admin->DeleteFile($iorfile_admin);
  42
  43 $AD = $admin->CreateProcess ("admin",
  44                               "-ORBdebuglevel $debug_level " .
  45                               "-o $admin_iorfile_admin");
  46
  47 $SV = $server->CreateProcess ("server",
  48                               "-ORBdebuglevel $debug_level " .
  49                               "-o $server_iorfile " .
  50                               "-k file://$server_iorfile_admin");
  51
  52 $CL = $client->CreateProcess ("client",
  53                               "-k file://$client_iorfile " .
  54                               "-a file://$client_iorfile_admin " .
  55                               "$test_type");
  56
  57 $admin_status = $AD->Spawn ();
  58
  59 if ($admin_status != 0) {
  60     print STDERR "ERROR: admin returned $admin_status\n";
  61     exit 1;
  62 }
  63
  64 if ($admin->WaitForFileTimed ($iorfile_admin,
  65                                $admin->ProcessStartWaitInterval()) == -1) {
  66     print STDERR "ERROR: cannot find file <$iorfile_admin>\n";
  67     $AD->Kill (); $AD->TimedWait (1);
  68     exit 1;
  69 }
  70 if ($admin->GetFile ($iorfile_admin) == -1) {
  71     print STDERR "ERROR: cannot retrieve file <$admin_iorfile_admin>\n";
  72     $AD->Kill (); $AD->TimedWait (1);
  73     exit 1;
  74 }
  75 if ($client->PutFile ($iorfile_admin) == -1) {
  76     print STDERR "ERROR: cannot set file <$client_iorfile_admin>\n";
  77     $AD->Kill (); $AD->TimedWait (1);
  78     exit 1;
  79 }
  80 if ($server->PutFile ($iorfile_admin) == -1) {
  81     print STDERR "ERROR: cannot set file <$server_iorfile_admin>\n";
  82     $AD->Kill (); $AD->TimedWait (1);
  83     exit 1;
  84 }
  85
  86 $server_status = $SV->Spawn ();
  87
  88 if ($server_status != 0) {
  89     print STDERR "ERROR: server returned $server_status\n";
  90     exit 1;
  91 }
  92
  93 sub KillServers{
  94     $SV->Kill (); $SV->TimedWait (1);
  95     $AD->Kill (); $AD->TimedWait (1);
  96 }
  97
  98 if ($server->WaitForFileTimed ($iorfile,
  99                                $server->ProcessStartWaitInterval()) == -1) {
 100     print STDERR "ERROR: cannot find file <$iorfile>\n";
 101     KillServers();
 102     exit 1;
 103 }
 104
 105 if ($server->GetFile ($iorfile) == -1) {
 106     print STDERR "ERROR: cannot retrieve file <$server_iorfile>\n";
 107     KillServers();
 108     exit 1;
 109 }
 110 if ($client->PutFile ($iorfile) == -1) {
 111     print STDERR "ERROR: cannot set file <$client_iorfile>\n";
 112     KillServers();
 113     exit 1;
 114 }
 115
 116 $client_status = $CL->SpawnWaitKill ($client->ProcessStartWaitInterval());
 117
 118 if ($client_status != 0) {
 119     print STDERR "ERROR: client returned $client_status\n";
 120     $status = 1;
 121 }
 122
 123 $server_status = $SV->WaitKill ($server->ProcessStopWaitInterval());
 124
 125 if ($server_status != 0) {
 126     print STDERR "ERROR: server returned $server_status\n";
 127     $status = 1;
 128 }
 129
 130 $admin_status = $AD->WaitKill ($admin->ProcessStopWaitInterval());
 131
 132 if ($admin_status != 0) {
 133     print STDERR "ERROR: admin returned $admin_status\n";
 134     $status = 1;
 135 }
 136
 137 $server->DeleteFile($iorfile);
 138 $client->DeleteFile($iorfile);
 139 $client->DeleteFile($iorfile_admin);
 140 $server->DeleteFile($iorfile_admin);
 141 $admin->DeleteFile($iorfile_admin);
 142
 143 exit $status;