Improved/refactored the run_test.pl files

1 files changed, 64 insertions, 120 deletions

diff --git a/TAO/tests/RTCORBA/Thread_Pool/run_test.pl b/TAO/tests/RTCORBA/Thread_Pool/run_test.pl
index 93e04f8d77a..7e5b1eb0e98 100755
--- a/TAO/tests/RTCORBA/Thread_Pool/run_test.pl
+++ b/TAO/tests/RTCORBA/Thread_Pool/run_test.pl
@@ -8,140 +8,82 @@ eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}'
 use lib '../../../../bin';
 use PerlACE::Run_Test;
 
+$number_of_clients = 3;
 $status = 0;
-$iorfile_1 = PerlACE::LocalFile ("ior_1");
-$iorfile_2 = PerlACE::LocalFile ("ior_2");
-$iorfile_3 = PerlACE::LocalFile ("ior_3");
 
-unlink $iorfile_1;
-unlink $iorfile_2;
-unlink $iorfile_3;
-
-$SV = new PerlACE::Process ("server");
-
-$CL1_1 = new PerlACE::Process ("client", "-k file://$iorfile_1");
-$CL1_2 = new PerlACE::Process ("client", "-k file://$iorfile_1");
-$CL1_3 = new PerlACE::Process ("client", "-k file://$iorfile_1");
-
-$CL2_1 = new PerlACE::Process ("client", "-k file://$iorfile_2");
-$CL2_2 = new PerlACE::Process ("client", "-k file://$iorfile_2");
-$CL2_3 = new PerlACE::Process ("client", "-k file://$iorfile_2");
-
-$CL3_1 = new PerlACE::Process ("client", "-k file://$iorfile_3");
-$CL3_2 = new PerlACE::Process ("client", "-k file://$iorfile_3");
-$CL3_3 = new PerlACE::Process ("client", "-k file://$iorfile_3 -x");
-
-$SV->Spawn ();
-
-if (PerlACE::waitforfile_timed ($iorfile_1, 5) == -1 ||
-    PerlACE::waitforfile_timed ($iorfile_2, 5) == -1 ||
-    PerlACE::waitforfile_timed ($iorfile_3, 5) == -1)
+@configurations = 
+    (
+     {
+         file => "ior_1", 
+         description => "Invoking methods on servant in default thread pool",
+     },
+     {
+         file => "ior_2", 
+         description => "Invoking methods on servant in first RT thread pool (without lanes)",
+     },
+     {
+         file => "ior_3", 
+         description => "Invoking methods on servant in second RT thread pool (with lanes)",
+     },
+     );
+
+for $test (@configurations)
 {
-    print STDERR "ERROR: cannot find file ior files: $iorfile_1; $iorfile_2; or $iorfile_3\n";
-    goto kill_server;
-}
-
-print STDERR "\n**************************************************\n";
-print STDERR "Invoking methods on servant in default thread pool\n";
-print STDERR "**************************************************\n\n";
-
-$CL1_1->Spawn ();
-$CL1_2->Spawn ();
-$CL1_3->Spawn ();
-
-$client = $CL1_1->WaitKill (120);
-
-if ($client != 0) {
-    print STDERR "ERROR: client returned $client\n";
-    $status = 1
+    unlink $test->{file};
 }
 
-$client = $CL1_2->WaitKill (30);
-
-if ($client != 0) {
-    print STDERR "ERROR: client returned $client\n";
-    $status = 1
-}
-
-$client = $CL1_3->WaitKill (30);
-
-if ($client != 0) {
-    print STDERR "ERROR: client returned $client\n";
-    $status = 1
-}
-
-if ($status != 0) 
+sub run_clients
 {
-    goto kill_server;
-}
-
-print STDERR "\n**************************************************\n";
-print STDERR "Invoking methods on servant in first RT thread pool\n";
-print STDERR "***************************************************\n\n";
-
-$CL2_1->Spawn ();
-$CL2_2->Spawn ();
-$CL2_3->Spawn ();
-
-$client = $CL2_1->WaitKill (120);
-
-if ($client != 0) {
-    print STDERR "ERROR: client returned $client\n";
-    $status = 1
+    my @parms = @_;
+    $arg = $parms[0];
+    $clients = $parms[1];
+
+    for ($i = 0; $i < $clients; $i++)
+    {
+        $CL[$i] = new PerlACE::Process ("client", $arg);
+        $CL[$i]->Spawn ();
+    }
+
+    for ($i = 0; $i < $clients; $i++)
+    {    
+        $client = $CL[$i]->WaitKill (120);
+        if ($client != 0) 
+        {
+            print STDERR "ERROR: client returned $client\n";
+            $status = 1;
+            goto kill_server;
+        }
+    }
 }
 
-$client = $CL2_2->WaitKill (30);
-
-if ($client != 0) {
-    print STDERR "ERROR: client returned $client\n";
-    $status = 1
-}
-
-$client = $CL2_3->WaitKill (30);
+$SV = new PerlACE::Process ("server");
 
-if ($client != 0) {
-    print STDERR "ERROR: client returned $client\n";
-    $status = 1
-}
+$SV->Spawn ();
 
-if ($status != 0) 
+for $test (@configurations)
 {
-    goto kill_server;
-}
-
-print STDERR "\n**************************************************\n";
-print STDERR "Invoking methods on servant in second RT thread pool\n";
-print STDERR "****************************************************\n\n";
-
-$CL3_1->Spawn ();
-$CL3_2->Spawn ();
-$CL3_3->Spawn ();
-
-$client = $CL3_1->WaitKill (120);
-
-if ($client != 0) {
-    print STDERR "ERROR: client returned $client\n";
-    $status = 1
+    if (PerlACE::waitforfile_timed ($test->{file}, 5) == -1)
+    {
+        print STDERR "ERROR: cannot find ior file: $file\n";
+        $status = 1;
+        goto kill_server;
+    }
 }
 
-$client = $CL3_2->WaitKill (30);
+for $test (@configurations)
+{
+    print STDERR "\n*************************************************************\n";
+    print STDERR "$test->{description}\n";
+    print STDERR "*************************************************************\n\n";
 
-if ($client != 0) {
-    print STDERR "ERROR: client returned $client\n";
-    $status = 1
+    run_clients ("-k file://$test->{file}", $number_of_clients);
 }
 
-$client = $CL3_3->WaitKill (30);
+print STDERR "\n************************\n";
+print STDERR "Shutting down the server\n";
+print STDERR "************************\n\n";
 
-if ($client != 0) {
-    print STDERR "ERROR: client returned $client\n";
-    $status = 1
-}
-
-if ($status != 0) 
-{
-    goto kill_server;
-}
+run_clients ("-k file://$configurations[0]->{file} -i 0 -x", 1);
 
 kill_server:
 
@@ -152,8 +94,10 @@ if ($server != 0) {
     $status = 1
 }
 
-unlink $iorfile_1;
-unlink $iorfile_2;
-unlink $iorfile_3;
+for $test (@configurations)
+{
+    unlink $test->{file};
+}
 
 exit $status
+