1 files changed, 65 insertions, 41 deletions

diff --git a/TAO/tests/RTCORBA/MT_Client_Protocol_Priority/run_test.pl b/TAO/tests/RTCORBA/MT_Client_Protocol_Priority/run_test.pl
index 561e877acb5..650ffcd2586 100755
--- a/TAO/tests/RTCORBA/MT_Client_Protocol_Priority/run_test.pl
+++ b/TAO/tests/RTCORBA/MT_Client_Protocol_Priority/run_test.pl
@@ -5,35 +5,40 @@ eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}'
 # $Id$
 # -*- perl -*-
 
-unshift @INC, '../../../../bin';
-require ACEutils;
-use Cwd;
+use lib '../../../../bin';
+use PerlACE::Run_Test;
 
-$cwd = getcwd();
+$status = 0;
+$quiet = 0;
+
+# check for -q flag
+if ($ARGV[0] eq '-q') {
+    $quiet = 1;
+}
 
 # Test parameters.
-$iorfile = "$cwd$DIR_SEPARATOR" . "test.ior";
-$data_file = "$cwd$DIR_SEPARATOR" . "test_run.data";
+$iorfile = PerlACE::LocalFile ("test.ior");
+$data_file = PerlACE::LocalFile ("test_run.data");
+
 $iterations = 50;
 $priority1 = 65;
 $priority2 = 70;
 $priority3 = 75;
-if ($^O eq "MSWin32")
-{
+
+if ($^O eq "MSWin32") {
     $priority1 = 6;
     $priority2 = 1;
     $priority3 = 5;
 }
 
-ACE::checkForTarget($cwd);
-
 # Clean up leftovers from previous runs.
-#unlink $iorfile;
-#unlink $data_file;
+unlink $iorfile;
+unlink $data_file;
 
+$server_conf = PerlACE::LocalFile ("server.conf");
 
 $server_args =
-    "-o $iorfile -ORBdebuglevel 1 -ORBsvcconf server.conf "
+    "-o $iorfile -ORBdebuglevel 1 -ORBsvcconf $server_conf "
     ."-ORBendpoint iiop://$TARGETHOSTNAME:0/priority=$priority1 "
     ."-ORBendpoint iiop://$TARGETHOSTNAME:0/priority=$priority2 "
     ."-ORBendpoint iiop://$TARGETHOSTNAME:0/priority=$priority3 "
@@ -45,38 +50,43 @@ $client_args =
     "-o file://$iorfile  "
     ."-a $priority1 -b $priority2 -e 1413566210 -f 0 -n $iterations";
 
+$SV = new PerlACE::Process ("server", $server_args);
+$CL = new PerlACE::Process ("client", $client_args);
 
 print STDERR "\n********** MT Client Protocol & CLIENT_PROPAGATED combo Test\n\n";
 
 # Redirect the output of the test run to a file, so that we can process it later.
+
 open (OLDOUT, ">&STDOUT");
 open (STDOUT, ">$data_file") or die "can't redirect stdout: $!";
 open (OLDERR, ">&STDERR");
 open (STDERR, ">&STDOUT") or die "can't redirect stderror: $!";
 
+# just here to quiet warnings
+$fh = \*OLDOUT;
+$fh = \*OLDERR;
+
 # Run server and client.
-$SV = Process::Create ($EXEPREFIX."server$EXE_EXT ",
-                       $server_args);
+$SV->Spawn ();
 
-if (ACE::waitforfile_timed ($iorfile, 10) == -1) {
-  print STDERR "ERROR: cannot find file <$iorfile>\n";
-  $SV->Kill (); $SV->TimedWait (1);
-  exit 1;
+if (PerlACE::waitforfile_timed ($iorfile, 10) == -1) {
+    print STDERR "ERROR: cannot find file <$iorfile>\n";
+    $SV->Kill (); 
+    exit 1;
 }
 
-$CL = Process::Create ($EXEPREFIX."client$EXE_EXT ",
-                       $client_args);
+$client = $CL->SpawnWaitKill (60);
 
-$client = $CL->TimedWait (60);
-if ($client == -1) {
-  print STDERR "ERROR: client timedout\n";
-  $CL->Kill (); $CL->TimedWait (1);
+if ($client != 0) {
+    print STDERR "ERROR: client returned $client\n";
+    $status = 1;
 }
 
-$server = $SV->TimedWait (60);
-if ($server == -1) {
-  print STDERR "ERROR: server timedout\n";
-  $SV->Kill (); $SV->TimedWait (1);
+$server = $SV->WaitKill (60);
+
+if ($server != 0) {
+    print STDERR "ERROR: server returned $server\n";
+    $status = 1;
 }
 
 close (STDERR);
@@ -86,18 +96,32 @@ open (STDERR, ">&OLDERR");
 
 unlink $iorfile;
 
-if ($server != 0 || $client != 0) {
-  exit 1;
-}
-
 # Run a processing script on the test output.
-$FL = Process::Create ($EXEPREFIX."process-output.pl",
-                       " $data_file $iterations $priority1 $priority2");
-$filter = $FL->TimedWait (60);
-if ($filter == -1) {
-  print STDERR "ERROR: filter timedout\n";
-  $FL->Kill (); $FL->TimedWait (1);
+print STDERR "\n********** Processing test output\n\n";
+
+$errors = system ("perl process-output.pl $data_file $iterations $priority1 $priority2") >> 8;
+
+if ($errors > 0) {
+    $status = 1;
+
+    if (!$quiet) {
+        print STDERR "Errors Detected, printing output\n";
+        if (open (DATA, "<$data_file")) {
+            print STDERR "================================= Begin\n";
+            print STDERR <DATA>;
+            print STDERR "================================= End\n";
+            close (DATA);
+        }
+        else {
+            print STDERR "ERROR: Could not open $data_file\n";
+        }
+        unlink $data_file;
+    }
 }
-  print STDERR "\n";
 
-exit 0;
+unlink $iorfile;
+
+# Clean up shmiop files
+unlink glob ("server_shmiop_*");
+
+exit $status;