Tue Mar 26 15:52:50 UTC 2013 Byron Harris <harrisb@ociweb.com>

10 files changed, 787 insertions, 0 deletions

diff --git a/TAO/ChangeLog_Asynch_ImR b/TAO/ChangeLog_Asynch_ImR
index a2ab5caf664..58ff12fc856 100644
--- a/TAO/ChangeLog_Asynch_ImR
+++ b/TAO/ChangeLog_Asynch_ImR
@@ -1,3 +1,18 @@
+Tue Mar 26 15:52:50 UTC 2013  Byron Harris  <harrisb@ociweb.com>
+
+        * bin/tao_other_tests.lst:
+        * orbsvcs/tests/ImplRepo/servers_interact_on_startup:
+        * orbsvcs/tests/ImplRepo/servers_interact_on_startup/README:
+        * orbsvcs/tests/ImplRepo/servers_interact_on_startup/Test.idl:
+        * orbsvcs/tests/ImplRepo/servers_interact_on_startup/Test_i.h:
+        * orbsvcs/tests/ImplRepo/servers_interact_on_startup/Test_i.cpp:
+        * orbsvcs/tests/ImplRepo/servers_interact_on_startup/client.cpp:
+        * orbsvcs/tests/ImplRepo/servers_interact_on_startup/run_test.pl:
+        * orbsvcs/tests/ImplRepo/servers_interact_on_startup/server.cpp:
+        * orbsvcs/tests/ImplRepo/servers_interact_on_startup/servers_interact_on_startup.mpc:
+
+          Added test for ImR pinging of ill-behaved, interacting servers.
+
 Mon Mar 25 20:52:13 UTC 2013  Phil Mesnier  <mesnier_p@ociweb.com>
 
         * orbsvcs/ImplRepo_Service/ImR_Locator_i.h:
diff --git a/TAO/bin/tao_other_tests.lst b/TAO/bin/tao_other_tests.lst
index 642fb9d0d5c..4130eb1d009 100644
--- a/TAO/bin/tao_other_tests.lst
+++ b/TAO/bin/tao_other_tests.lst
@@ -135,6 +135,7 @@ TAO/orbsvcs/tests/ImplRepo/ReconnectServer/run_test.pl: !MINIMUM !CORBA_E_COMPAC
 TAO/orbsvcs/tests/ImplRepo/ReconnectServer/run_test.pl -forwardalways: !MINIMUM !CORBA_E_COMPACT !CORBA_E_MICRO !WCHAR !ACE_FOR_TAO !LynxOS
 TAO/orbsvcs/tests/ImplRepo/ReconnectServer/run_test.pl -forwardonce: !MINIMUM !CORBA_E_COMPACT !CORBA_E_MICRO !WCHAR !ACE_FOR_TAO !LynxOS
 TAO/orbsvcs/tests/ImplRepo/RestartServer/run_test.pl: !ST !MINIMUM !CORBA_E_COMPACT !CORBA_E_MICRO !WCHAR !ACE_FOR_TAO !LynxOS !OpenVMS
+TAO/orbsvcs/tests/ImplRepo/servers_interact_on_startup/run_test.pl: !ST !MINIMUM !CORBA_E_COMPACT !CORBA_E_MICRO !WCHAR !ACE_FOR_TAO !LynxOS !OpenVMS
 TAO/orbsvcs/examples/ImR/Combined_Service/run_test.pl: !MINIMUM !CORBA_E_COMPACT !CORBA_E_MICRO !STATIC !ST !ACE_FOR_TAO !LynxOS
 TAO/orbsvcs/examples/CosEC/TypedSimple/run_test.pl: !MINIMUM !CORBA_E_COMPACT !CORBA_E_MICRO !NO_IFR !ACE_FOR_TAO !WCHAR
 TAO/orbsvcs/tests/CosEvent/Timeout/run_test.pl: !MINIMUM !CORBA_E_COMPACT !CORBA_E_MICRO !ST !NO_MESSAGING !ACE_FOR_TAO !LynxOS
diff --git a/TAO/orbsvcs/tests/ImplRepo/servers_interact_on_startup/README b/TAO/orbsvcs/tests/ImplRepo/servers_interact_on_startup/README
new file mode 100644
index 00000000000..952cb9b99a8
--- /dev/null
+++ b/TAO/orbsvcs/tests/ImplRepo/servers_interact_on_startup/README
@@ -0,0 +1,64 @@
+$Id$
+
+Servers Interacting on Startup Test
+===================================
+
+Description
+-----------
+
+This is a test of the implementation repository with various servers
+registered with it that interact with each other and may be
+ill-behaved (a server reports it is running but there is a delay in
+activating the POA). Furthermore, in this test, a server may make an
+invocation on another server before the first server's POA is
+activated. This results in a stack of ImR server ping requests.
+
+To achieve this there are three servers used:
+
+S1: This server makes an invocation to S2 after its POA has been
+created (which includes a notification to the ImR that it is running)
+but before the POA has been activated.
+
+S2: This server is similar to S1 but it makes an invocation to S3
+after its POA has been created.
+
+S3: The CORBA object for this server waits for awhile before replying
+to its request. Because of this it will take awhile for S2's ORB to
+start running.
+
+S1 and S2 are both launched by the Activator. S3 is directly spawned
+by the test.
+
+Two clients are also used:
+
+C1: Makes an invocation to S1 through the ImR so that S1 will start.
+
+C2: After C1 is started, a wait of the verification interval is made
+and then C2 is started and also makes an invocation to S1. The waiting
+over the verification interval is done to ensure that the ImR will
+ping S1 to verify it is still alive.
+
+In earlier versions of the ImR, the invocation from C2 to S1 would
+cause new ping requests to stack on top of the ping requests caused by
+C1's invocation to S2 and the original ping requests would be
+blocked. If S3's reply delay is long enough it can cause C2 to receive
+a TRANSIENT exception. For example, it was found on a Linux computer
+that if the request delay was set to 20 seconds ( the value for
+-server_reply_delay described below) the C2 would get this
+exception. If the delay was set to 30 seconds both C1 and C2 would get
+transient exceptions.
+
+Usage
+-----
+
+To run this test, run the run_test.pl perl script. It takes two
+optional arguments:
+
+-server_reply_delay <seconds> This is the delay in seconds the CORBA
+object in S3 will make before replying to a request.
+
+-v <milliseconds>
+The verification interval in milliseconds for the ImR to use.
+
+-?
+The usage and default value of the options.
diff --git a/TAO/orbsvcs/tests/ImplRepo/servers_interact_on_startup/Test.idl b/TAO/orbsvcs/tests/ImplRepo/servers_interact_on_startup/Test.idl
new file mode 100644
index 00000000000..fc0520fa18e
--- /dev/null
+++ b/TAO/orbsvcs/tests/ImplRepo/servers_interact_on_startup/Test.idl
@@ -0,0 +1,8 @@
+// $Id$
+
+interface Test
+{
+  // Return the number of the server
+  short get_server_num ();
+};
+
diff --git a/TAO/orbsvcs/tests/ImplRepo/servers_interact_on_startup/Test_i.cpp b/TAO/orbsvcs/tests/ImplRepo/servers_interact_on_startup/Test_i.cpp
new file mode 100644
index 00000000000..b911ccfaca5
--- /dev/null
+++ b/TAO/orbsvcs/tests/ImplRepo/servers_interact_on_startup/Test_i.cpp
@@ -0,0 +1,24 @@
+/* -*- C++ -*- $Id$ */
+
+#include "Test_i.h"
+
+Test_i::Test_i (CORBA::Short server_num,
+                CORBA::Short reply_delay_secs)
+  : server_num_ (server_num)
+  , reply_delay_secs_(reply_delay_secs)
+{
+}
+
+Test_i::~Test_i ()
+{
+}
+
+CORBA::Short
+Test_i::get_server_num ()
+{
+  ACE_DEBUG((LM_DEBUG,
+             "Server %d Test_i::get_server_num () sleeping for %d seconds\n",
+             this->server_num_, this->reply_delay_secs_));
+  ACE_OS::sleep (this->reply_delay_secs_);
+  return this->server_num_;
+}
diff --git a/TAO/orbsvcs/tests/ImplRepo/servers_interact_on_startup/Test_i.h b/TAO/orbsvcs/tests/ImplRepo/servers_interact_on_startup/Test_i.h
new file mode 100644
index 00000000000..e39992d776e
--- /dev/null
+++ b/TAO/orbsvcs/tests/ImplRepo/servers_interact_on_startup/Test_i.h
@@ -0,0 +1,30 @@
+/* -*- C++ -*- $Id$ */
+
+#ifndef TEST_I_H_
+#define TEST_I_H_
+
+#include "TestS.h"
+
+#if !defined (ACE_LACKS_PRAGMA_ONCE)
+#pragma once
+#endif /* ACE_LACKS_PRAGMA_ONCE */
+
+
+class  Test_i : public virtual POA_Test
+{
+public:
+  //Constructor
+  Test_i (short server_num, CORBA::Short reply_delay_secs);
+
+  //Destructor
+  virtual ~Test_i ();
+
+  virtual CORBA::Short get_server_num ();
+
+private:
+  CORBA::Short server_num_;
+  CORBA::Short reply_delay_secs_;
+
+};
+
+#endif /* TEST_I_H_ */
diff --git a/TAO/orbsvcs/tests/ImplRepo/servers_interact_on_startup/client.cpp b/TAO/orbsvcs/tests/ImplRepo/servers_interact_on_startup/client.cpp
new file mode 100644
index 00000000000..1bdafe6b282
--- /dev/null
+++ b/TAO/orbsvcs/tests/ImplRepo/servers_interact_on_startup/client.cpp
@@ -0,0 +1,72 @@
+// $Id$
+
+#include "TestC.h"
+#include <iostream>
+#include "ace/Get_Opt.h"
+#include "ace/OS_NS_unistd.h"
+
+int client_num = 0;
+ACE_CString server_ior;
+
+int
+parse_args (int argc, ACE_TCHAR *argv[])
+{
+  ACE_Get_Opt get_opts (argc, argv, ACE_TEXT("k:n:"));
+  int c;
+
+  while ((c = get_opts ()) != -1)
+    switch (c)
+      {
+      case 'k':
+        server_ior = get_opts.opt_arg ();
+        break;
+
+        case 'n':
+          client_num = ACE_OS::atoi (get_opts.opt_arg ());
+          break;
+
+      case '?':
+      default:
+        ACE_ERROR_RETURN ((LM_ERROR,
+                           "usage:  %s "
+                           "-k <server-ior> "
+                           "\n",
+                           argv [0]),
+                          -1);
+      }
+  // Indicates successful parsing of the command line
+  return 0;
+}
+
+int
+ACE_TMAIN (int argc, ACE_TCHAR *argv[])
+{
+  try {
+    // Initialize orb
+    CORBA::ORB_var orb = CORBA::ORB_init( argc, argv );
+
+    if (parse_args (argc, argv) != 0)
+      return 1;
+
+    ACE_DEBUG ((LM_DEBUG,
+                "(%P|%t|%T) Client %d sending request to %s\n",
+                client_num, server_ior.c_str ()));
+    CORBA::Object_var obj =
+      orb->string_to_object (server_ior.c_str ());
+    ACE_ASSERT (!CORBA::is_nil (obj.in ()));
+    Test_var test = Test::_narrow (obj.in());
+    ACE_ASSERT (!CORBA::is_nil (test.in()));
+    CORBA::Short n = test->get_server_num ();
+    ACE_DEBUG ((LM_DEBUG,
+                "(%P|%t|%T) Client %d received reply from server %d\n",
+                client_num, n));
+
+    return 0;
+
+  }
+  catch(const CORBA::Exception& ex) {
+    ex._tao_print_exception ("client:");
+  }
+
+  return -1;
+}
diff --git a/TAO/orbsvcs/tests/ImplRepo/servers_interact_on_startup/run_test.pl b/TAO/orbsvcs/tests/ImplRepo/servers_interact_on_startup/run_test.pl
new file mode 100755
index 00000000000..73783d38303
--- /dev/null
+++ b/TAO/orbsvcs/tests/ImplRepo/servers_interact_on_startup/run_test.pl
@@ -0,0 +1,358 @@
+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::TestTarget;
+
+$status = 0;
+
+my $debug_level = '0';
+my $imr_debug_level = $debug_level;
+my $servers_count = 3;
+my $client_count = 2;
+my $server_reply_delay = 5;
+my $usage = 0;
+
+# Ping interval in milliseconds
+my $verification_interval_msecs = 1000;
+
+if ($#ARGV >= 0) {
+    for (my $i = 0; $i <= $#ARGV; $i++) {
+	if ($ARGV[$i] eq '-debug') {
+	    $debug_level = '10';
+	    $imr_debug_level = '10';
+	    $i++;
+	}
+	elsif ($ARGV[$i] eq "-server_reply_delay") {
+	    $i++;
+	    $server_reply_delay = $ARGV[$i];
+	}
+	elsif ($ARGV[$i] eq "-v") {
+	    $i++;
+	    $verification_interval_msecs = $ARGV[$i];
+	}
+	else {
+	    $usage = 1;
+	    usage();
+	    exit 1;
+	}
+    }
+}
+
+my $tgt_num = 0;
+my $imr = PerlACE::TestTarget::create_target (++$tgt_num) || die "Create target $tgt_num failed\n";
+my $act = PerlACE::TestTarget::create_target (++$tgt_num) || die "Create target $tgt_num failed\n";
+my $ti =  PerlACE::TestTarget::create_target (++$tgt_num) || die "Create target $tgt_num failed\n";
+my @cli;
+
+# Have list indices match client IDs (C1, C2) with first element of list not being used.
+for(my $i = 0; $i <= $client_count; $i++) {
+    push (@cli, PerlACE::TestTarget::create_target (++$tgt_num)) || die "Create target $tgt_num failed\n";
+}
+
+my $refstyle = "-ORBobjrefstyle URL";
+my $obj_count = 1;
+my $port = $imr->RandomPort();
+
+my $forward_on_exception_arg = "-ORBForwardOnceOnTransient 1";
+
+my $debug_arg = "-ORBDebugLevel $debug_level";
+my $imr_debug_arg = "-ORBDebugLevel $imr_debug_level";
+if ($imr_debug_level == 10) {
+    $imr_debug_arg = $imr_debug_arg . " -ORBVerboseLogging 1 -ORBLogFile imr_loc.log ";
+}
+
+my $objprefix = "TestObject";
+
+$imriorfile = "imr_locator.ior";
+$actiorfile = "imr_activator.ior";
+
+my $imr_imriorfile = $imr->LocalFile ($imriorfile);
+my $act_imriorfile = $act->LocalFile ($imriorfile);
+my $ti_imriorfile = $ti->LocalFile ($imriorfile);
+my $act_actiorfile = $act->LocalFile ($actiorfile);
+
+my $IMR = $imr->CreateProcess ("$ENV{TAO_ROOT}/orbsvcs/ImplRepo_Service/tao_imr_locator");
+my $ACT = $act->CreateProcess ("$ENV{TAO_ROOT}/orbsvcs/ImplRepo_Service/tao_imr_activator");
+my $TI  = $ti->CreateProcess ("$ENV{ACE_ROOT}/bin/tao_imr");
+
+my @srviorfile;
+my @srv_imriorfile;
+my @srv_iorfile;
+my @srv;
+my @SRV;
+my @srvstatusfile;
+my @srv_statusfile;
+my @obj;
+my @srv_server_cmd;
+# Have list indices match server IDs (S1, S2, S3) with first element of list not being used.
+for(my $i = 0; $i <= $servers_count; $i++) {
+    push (@srv, PerlACE::TestTarget::create_target (++$tgt_num)) || die "Create target $tgt_num failed\n";
+    push (@obj, $objprefix. "_" . $i);
+    push (@srviorfile,  $obj[$i] . ".ior");
+    push (@srvstatusfile, $obj[$i] . ".status");
+    push (@srv_imriorfile, $srv[$i]->LocalFile ($imriorfile));
+    push (@srv_iorfile, $srv[$i]->LocalFile ($srviorfile[$i]));
+    push (@srv_statusfile, $srv[$i]->LocalFile ($srvstatusfile[$i]));
+    $srv[$i]->DeleteFile ($imriorfile);
+    push (@SRV, $srv[$i]->CreateProcess ("server"));
+    my $server_cmd = $SRV[$i]->Executable();
+    push (@srv_server_cmd, $imr->LocalFile ($server_cmd));
+}
+
+for(my $i = 0; $i <= $client_count; $i++) {
+    push (@CLI, $cli[$i]->CreateProcess ("client", "$debug_arg -k file://$srviorfile[1] -n $i $forward_on_exception_arg"));
+}
+
+sub cleanup_output {
+    $imr->DeleteFile ($imriorfile);
+    $act->DeleteFile ($imriorfile);
+    $ti->DeleteFile ($imriorfile);
+    $act->DeleteFile ($actiorfile);
+    for (my $i = 1; $i <= $servers_count; $i++) {
+	$srv[$i]->DeleteFile ($srviorfile[$i]);
+	$srv[$i]->DeleteFile ($srvstatusfile[$i]);
+    }
+}
+
+sub print_msg($)
+{
+    my $msg = shift;
+    my $bar = "===============================================================================";
+    print STDERR "\n\n$bar\n$msg\n$bar\n\n";
+}
+
+sub run_imr_util {
+    my $cmd = shift;
+    print "Running ImR utility with $cmd\n";
+    $TI->Arguments ("-ORBInitRef ImplRepoService=file://$ti_imriorfile $cmd");
+#    print ">>> " . $TI->CommandLine () . "\n";
+    return $TI->SpawnWaitKill($ti->ProcessStartWaitInterval());
+}
+
+# Register a server with ImR to get its IOR, then register again so it can later be invoked.
+# For the second registration the IOR of another server to invoke is passed.
+sub register_server_with_activator {
+    my $srv_id = shift;
+    my $srv_to_invoke_id = shift;
+
+    $srv_args =
+	"$debug_arg -orbuseimr 1 $refstyle ".
+	"$forward_on_exception_arg ".
+	"-ORBInitRef ImplRepoService=file://$imr_imriorfile -n $srv_id";
+
+    # First run to get its IOR.
+    $SRV[$srv_id]->Arguments ($srv_args);
+    print ">>> " . $SRV[$srv_id]->CommandLine () . "\n";
+    $SRV[$srv_id]->Spawn ();
+    if ($srv[$srv_id]->WaitForFileTimed ($srvstatusfile[$srv_id],
+					 $srv[$srv_id]->ProcessStartWaitInterval() + $srv_reply_delay) == -1) {
+        print STDERR "ERROR: cannot find file $srvstatusfile[$srv_id]\n";
+        $IMR->Kill (); $IMR->TimedWait (1);
+        return 1;
+    }
+
+    $srv_args = $srv_args . " -s file://$srviorfile[$srv_to_invoke_id]";
+
+    run_imr_util("ior $obj[$srv_id] -f $srviorfile[$srv_id]");
+    run_imr_util("shutdown $obj[$srv_id]");
+    run_imr_util("update $obj[$srv_id] -c \"server $srv_args\"");
+}
+
+my $start_time = time();
+
+cleanup_output ();
+
+sub run_test
+{
+    print "Running test with $servers_count servers and $obj_count objects.\n";
+
+    my $result = 0;
+
+    ##### Start ImplRepo #####
+
+    print_msg ("Start ImplRepo");
+
+    $IMR->Arguments ("-o $imr_imriorfile $refstyle -orbendpoint iiop://:$port ".
+		     "$forward_on_exception_arg ".
+		     "-d 1 $imr_debug_arg ".
+		     "-v $verification_interval_msecs");
+    print ">>> " . $IMR->CommandLine () . "\n";
+    $IMR_status = $IMR->Spawn ();
+
+    if ($IMR_status != 0) {
+        print STDERR "ERROR: ImplRepo Service returned $IMR_status\n";
+        return 1;
+    }
+    if ($imr->WaitForFileTimed ($imriorfile, $imr->ProcessStartWaitInterval()) == -1) {
+        print STDERR "ERROR: cannot find file <$imr_imriorfile>\n";
+        $IMR->Kill (); $IMR->TimedWait (1);
+        return 1;
+    }
+    if ($imr->GetFile ($imriorfile) == -1) {
+        print STDERR "ERROR: cannot retrieve file <$imr_imriorfile>\n";
+        $IMR->Kill (); $IMR->TimedWait (1);
+        return 1;
+    }
+    if ($act->PutFile ($imriorfile) == -1) {
+        print STDERR "ERROR: cannot set file <$act_imriorfile>\n";
+        $IMR->Kill (); $IMR->TimedWait (1);
+        return 1;
+    }
+    if ($ti->PutFile ($imriorfile) == -1) {
+        print STDERR "ERROR: cannot set file <$ti_imriorfile>\n";
+        $IMR->Kill (); $IMR->TimedWait (1);
+        return 1;
+    }
+    for (my $i = 1; $i <= $servers_count; $i++) {
+	if ($srv[$i]->PutFile ($imriorfile) == -1) {
+	    print STDERR "ERROR: cannot set file <$srv_imriorfile>\n";
+	    $IMR->Kill (); $IMR->TimedWait (1);
+	    return 1;
+	}
+    }
+
+    ##### Start Activator #####
+
+    print_msg ("Start Activator");
+
+    $ACT->Arguments ("$debug_arg -d 1 -o $act_actiorfile -ORBInitRef ImplRepoService=file://$act_imriorfile");
+    print ">>> " . $ACT->CommandLine () . "\n";
+
+    $ACT_status = $ACT->Spawn ();
+    if ($ACT_status != 0) {
+	print STDERR "ERROR: ImR Activator returned $ACT_status\n";
+	return 1;
+    }
+    if ($act->WaitForFileTimed ($actiorfile,$act->ProcessStartWaitInterval()) == -1) {
+	print STDERR "ERROR: cannot find file <$act_imriorfile>\n";
+	$ACT->Kill (); $ACT->TimedWait (1);
+	$IMR->Kill (); $IMR->TimedWait (1);
+	return 1;
+    }
+
+    ##### Start S3 #####
+
+    print_msg ("Start S3");
+
+    $SRV[3]->Arguments ("$debug_arg -orbuseimr 1 $refstyle -ORBInitRef ImplRepoService=file://$imr_imriorfile ".
+			    "-d $server_reply_delay -n 3");
+    print ">>> " . $SRV[3]->CommandLine () . "\n";
+    $SRV[3]-> Spawn();
+    if ($srv[3]->WaitForFileTimed ($srvstatusfile[3], $srv[3]->ProcessStartWaitInterval()) == -1) {
+        print STDERR "ERROR: cannot find file $srvstatusfile[3]\n";
+        $IMR->Kill (); $IMR->TimedWait (1);
+        return 1;
+    }
+    # Get its IOR so S2 can use to invoke S3
+    run_imr_util("ior $obj[3] -f $srviorfile[3]");
+
+    ##### Register S2 with ImR using Activator #####
+
+    print_msg ("Register S2 with ImR to start on demand");
+
+    register_server_with_activator(2, 3);
+
+    ##### Register S1 with ImR using Activator #####
+
+    print_msg ("Register S1 with ImR to start on demand");
+
+    register_server_with_activator(1, 2);
+
+    ##### C1 invokes S1 #####
+
+    print_msg ("C1 invokes S1");
+
+    print ">>> " . $CLI[1]->CommandLine () . "\n";
+    $CLI_status = $CLI[1]->Spawn ();
+    if ($CLI_status != 0) {
+	print STDERR "ERROR: client 1 returned $CLI_status\n";
+	return 1;
+    }
+
+    ##### C2 invokes S1 in parallel with C1 after ping interval #####
+
+    print_msg ("C2 invokes S1 in parallel with C1 after ping interval");
+
+    # Let ping interval pass to ensure another ping will be done.
+    sleep ($verification_interval_msecs / 1000 + 1);
+
+    print ">>> " . $CLI[2]->CommandLine () . "\n";
+    $CLI_status = $CLI[2]->Spawn ();
+    if ($CLI_status != 0) {
+	print STDERR "ERROR: client 2 returned $CLI_status\n";
+	return 1;
+    }
+
+    ##### Wait for clients to terminate #####
+    print_msg ("Wait for clients to terminate");
+    for (my $i = 1; $i <= $client_count; $i++) {
+	if ($CLI[$i]->WaitKill ($cli[$i]->ProcessStopWaitInterval () + $server_reply_delay + 60) == -1) {
+	    print STDERR "ERROR: client $i not terminated correctly\n";
+	    $status = 1;
+	}
+    }
+
+    print_msg ("Shutting down");
+
+    if ($srv[1]->WaitForFileTimed ($srvstatusfile[1], $srv[1]->ProcessStartWaitInterval() + $server_reply_delay) == -1) {
+        print STDERR "ERROR: cannot find file $srvstatusfile[1]\n";
+        $IMR->Kill (); $IMR->TimedWait (1);
+        $status = 1;
+    }
+
+    ##### Shutdown servers #####
+    for (my $i = 1; $i <= $servers_count; $i++ ) {
+        # Shutting down any server object within the server will shutdown the whole server
+        run_imr_util ("shutdown $obj[$i]");
+	if ($SRV[$i]->WaitKill ($srv[$i]->ProcessStopWaitInterval ()) == -1) {
+	    print STDERR "ERROR: Server $i not terminated correctly\n";
+	    $status = 1;
+	}
+    }
+
+    ##### Shutdown activator #####
+    my $ACT_status = $ACT->TerminateWaitKill ($act->ProcessStopWaitInterval());
+    if ($ACT_status != 0) {
+	print STDERR "ERROR: IMR Activator returned $ACT_status\n";
+	$status = 1;
+    }
+
+    ##### Shutdown locator #####
+    my $IMR_status = $IMR->TerminateWaitKill ($imr->ProcessStopWaitInterval());
+    if ($IMR_status != 0) {
+        print STDERR "ERROR: IMR returned $IMR_status\n";
+        $status = 1;
+    }
+
+    my $test_time = time() - $start_time;
+    print "\nFinished. The test took $test_time seconds.\n";
+
+    return $status;
+}
+
+END
+{
+    if (! $usage) {
+	cleanup_output ();
+    }
+
+}
+
+sub usage() {
+    print "Usage: run_test.pl ".
+	"[-server_reply_delay <request-seconds=$server_reply_delay>] ".
+	"[-v <verification-interval-milliseconds=$verification-interval>]\n"
+}
+
+###############################################################################
+###############################################################################
+
+my $ret = run_test();
+
+exit $ret;
diff --git a/TAO/orbsvcs/tests/ImplRepo/servers_interact_on_startup/server.cpp b/TAO/orbsvcs/tests/ImplRepo/servers_interact_on_startup/server.cpp
new file mode 100644
index 00000000000..fe6e8980ca7
--- /dev/null
+++ b/TAO/orbsvcs/tests/ImplRepo/servers_interact_on_startup/server.cpp
@@ -0,0 +1,182 @@
+// $Id$
+
+// server.cpp
+// This version uses the Implementation Repository.
+
+#include "Test_i.h"
+
+#include "tao/IORTable/IORTable.h"
+#include "tao/PortableServer/Root_POA.h"
+
+#include "ace/Get_Opt.h"
+#include "ace/streams.h"
+
+namespace
+{
+  ACE_CString toStr(int n)
+  {
+    char buf[20];
+    return ACE_OS::itoa(n, buf, 10);
+  }
+}
+
+PortableServer::POA_ptr
+createPOA(PortableServer::POA_ptr root_poa, const char* poa_name)
+{
+  PortableServer::LifespanPolicy_var life =
+    root_poa->create_lifespan_policy(PortableServer::PERSISTENT);
+
+  PortableServer::IdAssignmentPolicy_var assign =
+    root_poa->create_id_assignment_policy(PortableServer::USER_ID);
+
+  CORBA::PolicyList pols;
+  pols.length(2);
+  pols[0] = PortableServer::LifespanPolicy::_duplicate(life.in());
+  pols[1] = PortableServer::IdAssignmentPolicy::_duplicate(assign.in());
+
+  PortableServer::POAManager_var mgr = root_poa->the_POAManager();
+  PortableServer::POA_var poa =
+    root_poa->create_POA(poa_name, mgr.in(), pols);
+
+  life->destroy();
+  assign->destroy();
+
+  return poa._retn();
+}
+
+int
+ACE_TMAIN (int argc, ACE_TCHAR *argv[])
+{
+  try {
+    CORBA::ORB_var orb = CORBA::ORB_init(argc, argv);
+
+    ACE_CString other_server_ior;
+
+    int server_num = 0;
+    int reply_delay_secs = 0;
+
+    ACE_Get_Opt get_opts (argc, argv, ACE_TEXT ("s:d:n:?"));
+    int c;
+
+    while ((c = get_opts ()) != -1)
+      switch (c)
+        {
+        case 's':
+          other_server_ior = get_opts.opt_arg ();
+          break;
+
+        case 'd':
+          reply_delay_secs = ACE_OS::atoi (get_opts.opt_arg ());
+          break;
+
+        case 'n':
+          server_num = ACE_OS::atoi (get_opts.opt_arg ());
+          break;
+
+        case '?':
+          ACE_DEBUG ((LM_DEBUG,
+                      "usage: %s "
+                      "-s <ior-of-server-to-invoke> "
+                      "-d <seconds to delay before initializing POA> "
+                      "-n Number of the server\n",
+                      argv[0]));
+          return 1;
+          break;
+        }
+
+    CORBA::Object_var obj = orb->resolve_initial_references("RootPOA");
+    PortableServer::POA_var root_poa = PortableServer::POA::_narrow(obj.in());
+
+    PortableServer::POAManager_var mgr = root_poa->the_POAManager();
+
+    ACE_CString poa_name = ACE_CString("TestObject_") + toStr (server_num);
+
+    PortableServer::POA_var test_poa = createPOA(root_poa.in(), poa_name.c_str ());
+
+    ACE_DEBUG ((LM_DEBUG,
+                "(%P|%t|%T) Server %d created POA %s\n",
+                server_num, poa_name.c_str ()));
+
+    PortableServer::Servant_var<Test_i> test_servant =
+      new Test_i(server_num, reply_delay_secs);
+
+    PortableServer::ObjectId_var object_id =
+      PortableServer::string_to_ObjectId("test_object");
+
+    //
+    // Activate the servant with the test POA,
+    // obtain its object reference, and get a
+    // stringified IOR.
+    //
+    test_poa->activate_object_with_id(object_id.in(), test_servant.in());
+
+    //
+    // Create binding between "TestService" and
+    // the test object reference in the IOR Table.
+    // Use a TAO extension to get the non imrified poa
+    // to avoid forwarding requests back to the ImR.
+
+    TAO_Root_POA* tpoa = dynamic_cast<TAO_Root_POA*>(test_poa.in());
+    obj = tpoa->id_to_reference_i(object_id.in(), false);
+    CORBA::String_var test_ior = orb->object_to_string(obj.in());
+    obj = orb->resolve_initial_references("IORTable");
+    IORTable::Table_var table = IORTable::Table::_narrow(obj.in());
+    table->bind(poa_name.c_str (), test_ior.in());
+
+    // Make invocation to other server before POA is activated.
+    if (other_server_ior.length () > 0)
+      {
+        ACE_DEBUG ((LM_DEBUG,
+                    "(%P|%t|%T) Server %d sending request to %s\n",
+                    server_num, other_server_ior.c_str ()));
+        CORBA::Object_var other_server =
+          orb->string_to_object (other_server_ior.c_str ());
+        ACE_ASSERT (!CORBA::is_nil (other_server.in ()));
+        Test_var test = Test::_narrow (other_server.in());
+        ACE_ASSERT (!CORBA::is_nil (test.in()));
+        CORBA::Short n = test->get_server_num ();
+        ACE_DEBUG ((LM_DEBUG,
+                    "(%P|%t|%T) Server %d received reply from server %d\n", server_num, n));
+      }
+
+
+    //
+    // This server is now ready to run.
+    // This version does not create an IOR
+    // file as demonstrated in the
+    // Developer's Guide.  It assumes that
+    // users create IORs for the client using
+    // the tao_imr utility.
+    //
+    //
+    // Stop discarding requests.
+    //
+    mgr->activate();
+
+    ACE_DEBUG ((LM_DEBUG,
+                "(%P|%t|%T) Server %d started serving %s\n",
+                server_num, poa_name.c_str()));
+
+    {
+      ACE_CString status_file = poa_name + ACE_CString(".status");
+      ofstream out(status_file.c_str ());
+      out << "started" << endl;
+    }
+
+    orb->run();
+
+    root_poa->destroy(1,1);
+    orb->destroy();
+
+    ACE_DEBUG ((LM_DEBUG,
+                "(%P|%t|%T) Server %d ending serving of %s\n",
+                server_num, poa_name.c_str ()));
+
+  }
+  catch(const CORBA::Exception& ex) {
+    ex._tao_print_exception ("Server main()");
+    return 1;
+  }
+
+  return 0;
+}
diff --git a/TAO/orbsvcs/tests/ImplRepo/servers_interact_on_startup/servers_interact_on_startup.mpc b/TAO/orbsvcs/tests/ImplRepo/servers_interact_on_startup/servers_interact_on_startup.mpc
new file mode 100644
index 00000000000..bb6898e4972
--- /dev/null
+++ b/TAO/orbsvcs/tests/ImplRepo/servers_interact_on_startup/servers_interact_on_startup.mpc
@@ -0,0 +1,33 @@
+// $Id$
+
+project(*idl): taoidldefaults {
+  IDL_Files {
+    Test.idl
+  }
+
+  custom_only = 1
+}
+
+project(*server): taoserver, iortable, avoids_minimum_corba, avoids_corba_e_micro {
+  after += *idl
+  exename = server
+  IDL_Files {
+  }
+  Source_Files {
+    Test_i.cpp
+    server.cpp
+    TestC.cpp
+    TestS.cpp
+  }
+}
+
+project(*client): taoclient, anytypecode, avoids_minimum_corba {
+  after += *idl
+  exename = client
+  IDL_Files {
+  }
+  Source_Files {
+    client.cpp
+    TestC.cpp
+  }
+}