TAO/tests/Bug_2183_Regression/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 use lib "$ENV{ACE_ROOT}/bin";
   8 use PerlACE::TestTarget;
   9
  10
  11 my $server = PerlACE::TestTarget::create_target (1) || die "Create target 1 failed\n";
  12 my $client = PerlACE::TestTarget::create_target (2) || die "Create target 2 failed\n";
  13
  14
  15 # The server IOR file
  16 $iorbase = "server.ior";
  17 $server_ior_file = $server->LocalFile ($iorbase);
  18
  19 # The server configuration file
  20 $server_conf_file = "server.conf";
  21 $server_conf = $server->LocalFile ($server_conf_file);
  22
  23 $server->DeleteFile ($iorbase);
  24
  25 # The client and server processes
  26 $perl_executable = $^X;
  27 $perl_executable =~ s/\.exe//ig;
  28 if ($^O == 'VMS') {
  29     $perl_executable =~ s/000000\///g;
  30 }
  31
  32 $port = '15000';
  33
  34 # copy the configuation file
  35 if ($server->PutFile ($server_conf_file) == -1) {
  36     print STDERR "ERROR: cannot set file <$server_conf>\n";
  37     $SV->Kill (); $SV->TimedWait (1);
  38     return 1;
  39 }
  40
  41 $SV = $server->CreateProcess ("server",
  42                               "-o $server_ior_file " .
  43                               "-ORBEndpoint iiop://:$port " .
  44                               "-ORBSvcConf $server_conf");
  45
  46 $CL1 = $client->CreateProcess ("client", "-k file://$server_ior_file");
  47 $CL2 = $client->CreateProcess ("$perl_executable", "hang_client.pl ".
  48                                                    $server->{'HOSTNAME'});
  49
  50 $CL2->IgnoreHostRoot(1);
  51 $CL2->IgnoreExeSubDir(1);
  52
  53
  54 # Fire up the server
  55 $status_server = $SV->Spawn();
  56
  57 if ($status_server != 0) {
  58    print STDERR "ERROR: server returned $status_server\n";
  59    exit 1;
  60 }
  61
  62 # We can wait on the IOR file
  63 if ($server->WaitForFileTimed ($iorbase,
  64                                $server->ProcessStartWaitInterval()) == -1) {
  65     print STDERR "ERROR: cannot find file <$server_ior_file>\n";
  66     $SV->Kill (); $SV->TimedWait (1);
  67     exit 1;
  68 }
  69
  70 $CL2->Spawn ();
  71
  72 $CL2->Wait ($server->ProcessStartWaitInterval());
  73
  74 $client_status = $CL1->SpawnWaitKill ($server->ProcessStartWaitInterval());
  75
  76 if ($client_status != 0) {
  77     print STDERR "ERROR: Bug #2183 Regression failed. Client returned $client_status\n";
  78     $status = 1;
  79     $SV->Kill ();
  80     $CL2->Kill ();
  81     $server->DeleteFile ($iorbase);
  82     exit $status;
  83 }
  84
  85 print "Test succeeded !!!\n";
  86
  87 # Clean up and return
  88 $SV->TerminateWaitKill ($server->ProcessStopWaitInterval());
  89 $CL2->TerminateWaitKill ($server->ProcessStopWaitInterval());
  90
  91 $server->DeleteFile ($iorbase);
  92
  93 exit 0;