diff options
Diffstat (limited to 'TAO/tests/RTCORBA/MT_Client_Protocol_Priority/run_test.pl')
-rwxr-xr-x | TAO/tests/RTCORBA/MT_Client_Protocol_Priority/run_test.pl | 106 |
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; |