1 files changed, 112 insertions, 0 deletions
diff --git a/TAO/tests/RTCORBA/Policy_Combinations/run_test.pl b/TAO/tests/RTCORBA/Policy_Combinations/run_test.pl
new file mode 100755
index 00000000000..d36852652b7
--- /dev/null
+++ b/TAO/tests/RTCORBA/Policy_Combinations/run_test.pl
@@ -0,0 +1,112 @@
+eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}'
+    & eval 'exec perl -S $0 $argv:q'
+    if 0;
+
+# $Id$
+# -*- perl -*-
+
+use lib "$ENV{ACE_ROOT}/bin";
+use PerlACE::Run_Test;
+
+$status = 0;
+
+@iorfiles = 
+    (
+     "root",
+     "child",
+     "default_pool_no_bands_client_propagated",
+     "default_pool_no_bands_server_declared",
+     "no_lanes_no_bands_client_propagated",
+     "no_lanes_no_bands_server_declared",
+     "lanes_no_bands_client_propagated",
+     "lanes_no_bands_server_declared",
+     "default_pool_bands_client_propagated",
+     "default_pool_bands_server_declared",
+     "no_lanes_bands_client_propagated",
+     "no_lanes_bands_server_declared",
+     "lanes_bands_client_propagated",
+     "lanes_bands_server_declared",
+     );
+
+sub run_client
+{
+    $CL = new PerlACE::Process ("client", @_);
+
+    $CL->Spawn ();
+    
+    $client = $CL->WaitKill (120);
+
+    if ($client != 0) 
+    {
+        print STDERR "ERROR: client returned $client\n";
+        $status = 1;
+        goto kill_server;
+    }
+}
+
+for $file (@iorfiles)
+{
+    unlink $file;
+}
+
+if (PerlACE::is_vxworks_test()) {
+    $SV = new PerlACE::ProcessVX ("server");
+}
+else {
+    $SV = new PerlACE::Process ("server");
+}
+$SV->Spawn ();
+
+for $file (@iorfiles)
+{
+    $file = PerlACE::LocalFile($file);
+    if (PerlACE::waitforfile_timed ($file, $PerlACE::wait_interval_for_process_creation) == -1)
+    {
+        $server = $SV->TimedWait (1);
+        if ($server == 2) 
+        {
+            # Mark as no longer running to avoid errors on exit.
+            $SV->{RUNNING} = 0;
+            exit $status;
+        } 
+        else
+        {            
+            print STDERR "ERROR: cannot find ior file: $file\n";
+            $status = 1;
+            goto kill_server;
+        }
+    }
+      
+    print STDERR "\n******************************************************\n";
+    print STDERR "Invoking methods on servant in $file poa\n";
+    print STDERR "******************************************************\n\n";
+    
+    run_client ("-k file://$file");
+}
+
+{
+    print STDERR "\n**************************\n";
+    print STDERR "Shutting down the server\n";
+    print STDERR "**************************\n\n";
+    
+    run_client ("-k file://$iorfiles[0] -i 0 -x");
+}
+
+ kill_server:
+    
+{
+    $server = $SV->WaitKill (5);
+    
+    if ($server != 0) 
+    {
+        print STDERR "ERROR: server returned $server\n";
+        $status = 1;
+    }
+    
+    for $file (@iorfiles)
+    {
+        unlink $file;
+    }
+}
+
+exit $status;