TAO/orbsvcs/tests/ImplRepo/oneway/run_test.pl

   1 eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}'
   2     & eval 'exec perl -S $0 $argv:q'
   3     if 0;
   4
   5 # -*- perl -*-
   6
   7 ###############################################################################
   8 use lib "$ENV{ACE_ROOT}/bin";
   9 use PerlACE::TestTarget;
  10
  11 $status = 0;
  12 $debug_level = 0;
  13
  14 if ($#ARGV >= 0) {
  15     for (my $i = 0; $i <= $#ARGV; $i++) {
  16         if ($ARGV[$i] eq '-debug') {
  17             $debug_level = 10;
  18             $i++;
  19         }
  20         elsif ($ARGV[$i] eq "-servers") {
  21             $i++;
  22             $servers_count = $ARGV[$i];
  23         }
  24         else {
  25             usage();
  26             exit 1;
  27         }
  28     }
  29 }
  30
  31 #$ENV{ACE_TEST_VERBOSE} = "1";
  32
  33 my $tgt_num = 0;
  34 my $imr = PerlACE::TestTarget::create_target (++$tgt_num) || die "Create target $tgt_num failed\n";
  35 my $act = PerlACE::TestTarget::create_target (++$tgt_num) || die "Create target $tgt_num failed\n";
  36 my $ti  = PerlACE::TestTarget::create_target (++$tgt_num) || die "Create target $tgt_num failed\n";
  37 my $cli = PerlACE::TestTarget::create_target (++$tgt_num) || die "Create target $tgt_num failed\n";
  38 my $cli_ds = PerlACE::TestTarget::create_target (++$tgt_num) || die "Create target $tgt_num failed\n";
  39 my $srv = PerlACE::TestTarget::create_target (++$tgt_num) || die "Create target $tgt_num failed\n";
  40
  41 my $refstyle = " -ORBobjrefstyle URL";
  42 my $port = 9876;
  43
  44 my $status_file_name = "TestObject.status";
  45 my $client_wait_time = 10;
  46
  47 $imriorfile = "imr_locator.ior";
  48 $actiorfile = "imr_activator.ior";
  49
  50 my $imr_imriorfile = $imr->LocalFile ($imriorfile);
  51 my $act_imriorfile = $act->LocalFile ($imriorfile);
  52 my $ti_imriorfile = $ti->LocalFile ($imriorfile);
  53 my $srv_imriorfile = $srv->LocalFile ($imriorfile);
  54 my $act_actiorfile = $act->LocalFile ($actiorfile);
  55
  56 $IMR = $imr->CreateProcess ("$ENV{TAO_ROOT}/orbsvcs/ImplRepo_Service/tao_imr_locator");
  57 $ACT = $act->CreateProcess ("$ENV{TAO_ROOT}/orbsvcs/ImplRepo_Service/tao_imr_activator");
  58 $TI = $ti->CreateProcess ("$ENV{ACE_ROOT}/bin/tao_imr");
  59
  60 $CLI = $cli->CreateProcess ("client");
  61 $CLI_DS = $cli_ds->CreateProcess ("client_ds");
  62 $SRV = $srv->CreateProcess ("server");
  63 my $srv_server_cmd =  $imr->LocalFile ($SRV->Executable());
  64
  65 # Make sure the files are gone, so we can wait on them.
  66 $imr->DeleteFile ($imriorfile);
  67 $act->DeleteFile ($imriorfile);
  68 $ti->DeleteFile ($imriorfile);
  69 $srv->DeleteFile ($imriorfile);
  70 $act->DeleteFile ($actiorfile);
  71
  72 my $stdout_file      = "test.out";
  73 my $stderr_file      = "test.err";
  74 my $ti_stdout_file = $ti->LocalFile ($stdout_file);
  75 my $ti_stderr_file = $ti->LocalFile ($stderr_file);
  76
  77 # Clean up after exit call
  78 END
  79 {
  80     $imr->DeleteFile ($imriorfile);
  81     $act->DeleteFile ($imriorfile);
  82     $ti->DeleteFile ($imriorfile);
  83     $srv->DeleteFile ($imriorfile);
  84     $act->DeleteFile ($actiorfile);
  85
  86     $ti->DeleteFile ($stdout_file);
  87     $ti->DeleteFile ($stderr_file);
  88
  89     # Remove any stray server status files caused by aborting services
  90     unlink <*.status>;
  91 }
  92
  93 sub redirect_output()
  94 {
  95     open(OLDOUT, ">&", \*STDOUT) or die "Can't dup STDOUT: $!";
  96     open(OLDERR, ">&", \*STDERR) or die "Can't dup STDERR: $!";
  97     open STDERR, '>', $ti_stderr_file;
  98     open STDOUT, '>', $ti_stdout_file;
  99 }
 100
 101 sub restore_output()
 102 {
 103     open(STDERR, ">&OLDERR") or die "Can't dup OLDERR: $!";
 104     open(STDOUT, ">&OLDOUT") or die "Can't dup OLDOUT: $!";
 105 }
 106
 107 sub server_setup ()
 108 {
 109     my $act_dbg = "-ORBDebugLevel $debug_level -ORBLogFile act.log" if ($debug_level > 0);
 110     $ACT->Arguments ("-d 5 -l -o $act_actiorfile $act_dbg -ORBInitRef ImplRepoService=file://$act_imriorfile");
 111
 112     $ACT_status = $ACT->Spawn ();
 113     if ($ACT_status != 0) {
 114         print STDERR "ERROR: ImR Activator returned $ACT_status\n";
 115         return 1;
 116     }
 117     if ($act->WaitForFileTimed ($actiorfile,$act->ProcessStartWaitInterval()) == -1) {
 118         print STDERR "ERROR: cannot find file <$act_imriorfile>\n";
 119         $ACT->Kill (); $ACT->TimedWait (1);
 120         $IMR->Kill (); $IMR->TimedWait (1);
 121         return 1;
 122     }
 123
 124     ##### Add servers to activator #####
 125     $srv->DeleteFile ($status_file_name);
 126     my $srv_dbg = "-ORBDebugLevel $debug_level -ORBLogFile server.log " if ($debug_level > 0);
 127
 128     $TI->Arguments ("-ORBInitRef ImplRepoService=file://$ti_imriorfile ".
 129                     "add TestObject_a -c \"".
 130                     $srv_server_cmd.
 131                     " -o server.ior -ORBUseIMR 1 $srv_dbg".
 132                     "-ORBInitRef ImplRepoService=file://$imr_imriorfile\"");
 133
 134     $TI_status = $TI->SpawnWaitKill ($ti->ProcessStartWaitInterval());
 135     if ($TI_status != 0) {
 136         print STDERR "ERROR: tao_imr returned $TI_status\n";
 137         $ACT->Kill (); $ACT->TimedWait (1);
 138         $IMR->Kill (); $IMR->TimedWait (1);
 139         return 1;
 140     }
 141 }
 142
 143 sub make_server_requests($$)
 144 {
 145     my $usefile = shift;
 146     my $proc = shift;
 147
 148     my $init_ref = "-ORBInitRef Test=";
 149     if ($usefile == 0) {
 150         $init_ref .= "corbaloc::1.2\@localhost:$port/TestObject_a";
 151     }
 152     else {
 153         $init_ref .= "file://server.ior";
 154     }
 155     my $svc_conf = "-ORBSvcConf defsync.conf" if ($proc == $CLI_DS);
 156     my $debug_args = "-ORBDebugLevel $debug_level -ORBLogFile client.log" if ($debug_level > 0);
 157
 158     print "Making requests using $init_ref $svc_conf $debug_args\n";
 159     $proc->Arguments ("$init_ref $svc_conf $debug_args");
 160
 161     $CLI_status = $proc->SpawnWaitKill ($cli->ProcessStartWaitInterval());
 162     if ($CLI_status != 0) {
 163         print STDERR "ERROR: client returned $CLI_status\n";
 164         $status = 1;
 165     }
 166 }
 167
 168 sub shutdown_server()
 169 {
 170     # Shutting down any server object within the server will shutdown the whole server
 171     $TI->Arguments ("-ORBInitRef ImplRepoService=file://$ti_imriorfile ".
 172                     "shutdown TestObject_a");
 173     $TI_status = $TI->SpawnWaitKill ($ti->ProcessStartWaitInterval());
 174     if ($TI_status != 0) {
 175         print STDERR "ERROR: tao_imr kill returned $TI_status\n";
 176         $status = 1;
 177     }
 178     $srv->DeleteFile ($status_file_name);
 179 }
 180
 181 sub oneway_sync_test
 182 {
 183     print "Running oneway sync test.\n";
 184
 185     my $start_time = time();
 186     my $debug_args = "-d $debug_level -ORBDebugLevel $debug_level -ORBLogFile imr.log" if ($debug_level > 0);
 187     $IMR->Arguments ("-v 1000 -o $imr_imriorfile -orbendpoint iiop://:$port $debug_args");
 188
 189     ##### Start ImplRepo #####
 190     $IMR_status = $IMR->Spawn ();
 191     if ($IMR_status != 0) {
 192         print STDERR "ERROR: ImplRepo Service returned $IMR_status\n";
 193         return 1;
 194     }
 195     if ($imr->WaitForFileTimed ($imriorfile, $imr->ProcessStartWaitInterval()) == -1) {
 196         print STDERR "ERROR: cannot find file <$imr_imriorfile>\n";
 197         $IMR->Kill (); $IMR->TimedWait (1);
 198         return 1;
 199     }
 200     if ($imr->GetFile ($imriorfile) == -1) {
 201         print STDERR "ERROR: cannot retrieve file <$imr_imriorfile>\n";
 202         $IMR->Kill (); $IMR->TimedWait (1);
 203         return 1;
 204     }
 205     if ($act->PutFile ($imriorfile) == -1) {
 206         print STDERR "ERROR: cannot set file <$act_imriorfile>\n";
 207         $IMR->Kill (); $IMR->TimedWait (1);
 208         return 1;
 209     }
 210     if ($ti->PutFile ($imriorfile) == -1) {
 211         print STDERR "ERROR: cannot set file <$ti_imriorfile>\n";
 212         $IMR->Kill (); $IMR->TimedWait (1);
 213         return 1;
 214     }
 215     if ($srv->PutFile ($imriorfile) == -1) {
 216         print STDERR "ERROR: cannot set file <$srv_imriorfile>\n";
 217         $IMR->Kill (); $IMR->TimedWait (1);
 218         return 1;
 219     }
 220
 221     server_setup ();
 222
 223     make_server_requests(0, $CLI);
 224     make_server_requests(1, $CLI);
 225     make_server_requests(1, $CLI_DS);
 226
 227     shutdown_server ();
 228
 229     my $ACT_status = $ACT->TerminateWaitKill ($act->ProcessStopWaitInterval());
 230     if ($ACT_status != 0) {
 231         print STDERR "ERROR: IMR Activator returned $ACT_status\n";
 232         $status = 1;
 233     }
 234
 235     my $IMR_status = $IMR->TerminateWaitKill ($imr->ProcessStopWaitInterval());
 236     if ($IMR_status != 0) {
 237         print STDERR "ERROR: IMR returned $IMR_status\n";
 238         $status = 1;
 239     }
 240
 241     my $test_time = time() - $start_time;
 242
 243     print "\nFinished. The test took $test_time seconds.\n";
 244
 245     return $status;
 246 }
 247
 248 sub usage() {
 249     print "Usage: run_test.pl ".
 250         "[-servers <num=$servers_count>]\n";
 251 }
 252
 253 ###############################################################################
 254 ###############################################################################
 255
 256 my $ret = oneway_sync_test();
 257
 258 exit $ret;