Mon Apr 11 12:58:12 UTC 2005 Martin Corino <mcorino@remedy.nl>

4 files changed, 548 insertions, 6 deletions

diff --git a/bin/PerlACE/ProcessVX.pm b/bin/PerlACE/ProcessVX.pm
new file mode 100644
index 00000000000..5602c19be40
--- /dev/null
+++ b/bin/PerlACE/ProcessVX.pm
@@ -0,0 +1,64 @@
+# $Id$
+
+package PerlACE::ProcessVX;
+
+use strict;
+use English;
+use POSIX qw(:time_h);
+
+$PerlACE::ProcessVX::ExeSubDir = './';
+
+sub delay_factor {
+  my($lps)    = 128;
+  my($factor) = 1;
+
+  ## Keep increasing the loops per second until the amount of time
+  ## exceeds the number of clocks per second.  The original code
+  ## did not multiply $ticks by 8 but, for faster machines, it doesn't
+  ## seem to return false values.  The multiplication is done to minimize
+  ## the amount of time it takes to determine the correct factor.
+  while(($lps <<= 1)) {
+    my($ticks) = clock();
+    for(my $i = $lps; $i >= 0; $i--) {
+    }
+    $ticks = clock() - $ticks;
+    if ($ticks * 8 >= CLOCKS_PER_SEC) {
+      $factor = 500000 / (($lps / $ticks) * CLOCKS_PER_SEC);
+      last;
+    }
+  }
+
+  return $factor;
+}
+
+### Check for -ExeSubDir commands, store the last one
+my @new_argv = ();
+
+for(my $i = 0; $i <= $#ARGV; ++$i) {
+    if ($ARGV[$i] eq '-ExeSubDir') {
+        if (defined $ARGV[$i + 1]) {
+            $PerlACE::ProcessVX::ExeSubDir = $ARGV[++$i].'/';
+        }
+        else {
+            print STDERR "You must pass a directory with ExeSubDir\n";
+            exit(1);
+        }
+    }
+    else {
+        push @new_argv, $ARGV[$i];
+    }
+}
+@ARGV = @new_argv;
+
+$PerlACE::ProcessVX::WAIT_DELAY_FACTOR = $ENV{"ACE_RUNTEST_DELAY"};
+
+if ($OSNAME eq "MSWin32") {
+	require PerlACE::ProcessVX_Win32;
+}
+else {
+	print STDERR "PerlACE::ProcessVX not supported on Unix yet!";
+	exit(1);
+	## require PerlACE::Process_Unix;
+}
+
+1;
diff --git a/bin/PerlACE/ProcessVX_Win32.pm b/bin/PerlACE/ProcessVX_Win32.pm
new file mode 100644
index 00000000000..9933a51f06c
--- /dev/null
+++ b/bin/PerlACE/ProcessVX_Win32.pm
@@ -0,0 +1,455 @@
+# $Id$
+
+package PerlACE::ProcessVX;
+
+use strict;
+use Win32::Process;
+use File::Basename;
+use File::Spec;
+use FileHandle;
+use Cwd;
+
+###############################################################################
+
+# This is what GetExitCode will return if the process is still running.
+my $STILL_ACTIVE = 259;
+
+my $set_vx_defgw = 1;
+my $do_vx_init = (defined $ENV{"ACE_RUN_VX_NO_INITIAL_REBOOT"}) ? 0 : 1;
+
+###############################################################################
+
+### Constructor and Destructor
+
+sub new
+{
+    my $proto = shift;
+    my $class = ref ($proto) || $proto;
+    my $self = {};
+
+    $self->{RUNNING} = 0;
+    $self->{IGNOREEXESUBDIR} = 1;
+    $self->{PROCESS} = undef;
+    $self->{EXECUTABLE} = shift;
+    $self->{ARGUMENTS} = shift;
+    if (!defined $PerlACE::ProcessVX::WAIT_DELAY_FACTOR) {
+        $PerlACE::ProcessVX::WAIT_DELAY_FACTOR = 2;
+    }
+    $self->{WINDSH} = $ENV{"ACE_RUN_WINDSH"};
+    if (!defined $self->{WINDSH}) {
+        $self->{WINDSH} = $ENV{"WIND_BASE"} . "\\host\\" . $ENV{"WIND_HOST_TYPE"} . "\\bin\\windsh.exe";
+    }
+    $self->{REBOOT_CMD} = $ENV{"ACE_RUN_VX_REBOOT_CMD"};
+    if (!defined $self->{REBOOT_CMD}) {
+        $self->{REBOOT_CMD} = "reboot";
+    }
+    $self->{REBOOT_TIME} = $ENV{"ACE_RUN_VX_REBOOT_TIME"};
+    if (!defined $self->{REBOOT_TIME}) {
+        $self->{REBOOT_TIME} = 90;
+    }
+
+    bless ($self, $class);
+    return $self;
+}
+
+sub DESTROY
+{
+    my $self = shift;
+
+    if ($self->{RUNNING} == 1) {
+        print STDERR "ERROR: <", $self->{EXECUTABLE},
+                     "> still running upon object destruction\n";
+        $self->Kill ();
+    }
+    
+    if (!defined $ENV{'ACE_TEST_VERBOSE'}) {
+        unlink "run_test.vxs";
+    }
+}
+
+###############################################################################
+
+### Some Accessors
+
+sub Normalize_Executable_Name
+{
+    my $executable = shift;
+
+    my $basename = basename ($executable);
+    my $dirname = dirname ($executable). '/';
+
+    $executable = $dirname.$PerlACE::ProcessVX::ExeSubDir.$basename.".out";
+
+    ## Installed executables do not conform to the ExeSubDir
+    if (! -e $executable && -e $dirname.$basename.'.out') {
+      $executable = $dirname.$basename.'.out';
+    }
+
+    $executable =~ s/\//\\/g; # / <- # color coding issue in devenv
+
+    return $executable;
+}
+
+
+sub Executable
+{
+    my $self = shift;
+
+    if (@_ != 0) {
+        $self->{EXECUTABLE} = shift;
+    }
+
+    my $executable = $self->{EXECUTABLE};
+
+    if ($self->{IGNOREEXESUBDIR} == 0) {
+      $executable = PerlACE::ProcessVX::Normalize_Executable_Name ($executable);
+    }
+    else {
+      $executable = $executable.".out";
+      $executable =~ s/\//\\/g; # / <- # color coding issue in devenv
+    }
+
+    return $executable;
+}
+
+sub Arguments
+{
+    my $self = shift;
+
+    if (@_ != 0) {
+        $self->{ARGUMENTS} = shift;
+    }
+
+    return $self->{ARGUMENTS};
+}
+
+sub CommandLine ()
+{
+    my $self = shift;
+
+    my $commandline = $self->Executable ();
+
+    if (defined $self->{ARGUMENTS}) {
+        $commandline .= ' '.$self->{ARGUMENTS};
+    }
+
+    return $commandline;
+}
+
+sub IgnoreExeSubDir
+{
+    my $self = shift;
+
+    if (@_ != 0) {
+        $self->{IGNOREEXESUBDIR} = shift;
+    }
+
+    return $self->{IGNOREEXESUBDIR};
+}
+
+###############################################################################
+
+### Spawning processes
+
+
+# Spawn the process and continue.
+
+sub Spawn ()
+{
+    my $self = shift;
+
+    if ($self->{RUNNING} == 1) {
+        print STDERR "ERROR: Cannot Spawn: <", $self->Executable (),
+                     "> already running\n";
+        return -1;
+    }
+
+    if (!defined $self->{EXECUTABLE}) {
+        print STDERR "ERROR: Cannot Spawn: No executable specified\n";
+        return -1;
+    }
+
+    if (!-x $self->{WINDSH}) {
+        print STDERR "ERROR: Cannot Spawn: <", $self->{WINDSH},
+                     "> not executable\n";
+        return -1;
+    }
+    
+    if ($self->{IGNOREEXESUBDIR} == 0) {
+        if (!-f $self->Executable ()) {
+            print STDERR "ERROR: Cannot Spawn: <", $self->Executable (),
+                         "> not found\n";
+            return -1;
+        }
+    }
+
+    my $status = 0;
+
+    my $hard_reboot = 0;
+    
+    my $cmdline;
+    ##
+    ## check if VxWorks kernel is reachable
+    $cmdline = $self->{WINDSH} . " -e \"shParse {exit}\" " . $ENV{"ACE_RUN_VX_TGTSVR"};
+    if (defined $ENV{'ACE_TEST_VERBOSE'}) {
+        print "Check ALIVE: $cmdline\n";
+    }
+    Win32::Process::Create ($self->{PROCESS},
+                            $self->{WINDSH},
+                            $cmdline,
+                            0,
+                            0,
+                            '.');
+    Win32::Process::GetExitCode ($self->{PROCESS}, $status);
+    if ($status != $STILL_ACTIVE) {
+        print STDERR "ERROR: Spawn failed for <", $self->{WINDSH}, ">\n";
+        exit $status;
+    }
+    if (defined $ENV{'ACE_TEST_VERBOSE'}) {
+        print "Status: $status\n";
+    }
+    $self->{RUNNING} = 1;
+    $status = $self->TimedWait (5);
+    if (defined $ENV{'ACE_TEST_VERBOSE'}) {
+        print "TimedWait Status: $status\n";
+    }
+    if ($status == -1) {
+        $self->Kill ();
+        if (defined $ENV{'ACE_RUN_VX_HARD_REBOOT_CMD'}) {
+            system($ENV{'ACE_RUN_VX_HARD_REBOOT_CMD'});
+            $set_vx_defgw = 1;
+            $do_vx_init = 0;
+            $hard_reboot = 1;
+            sleep($self->{REBOOT_TIME}+10);
+        }
+        else {
+            print STDERR "ERROR: Cannot get connection with VxWorks target\n";
+            exit $status;
+        }
+    }
+    
+    ##
+    ## initialize VxWorks kernel (reboot!) if needed
+    if (!$hard_reboot && ($do_vx_init || $ENV{'ACE_RUN_VX_TGT_REBOOT'})) {
+        $cmdline = $self->{WINDSH} . " -e \"shParse {" . $self->{REBOOT_CMD} . "}\" " . $ENV{'ACE_RUN_VX_TGTSVR'};
+        if (defined $ENV{'ACE_TEST_VERBOSE'}) {
+            print $cmdline . "\n";
+        }
+        ## reboot VxWorks kernel to cleanup
+        Win32::Process::Create ($self->{PROCESS},
+                                $self->{WINDSH},
+                                $cmdline,
+                                0,
+                                0,
+                                '.');
+        if (defined $ENV{'ACE_TEST_VERBOSE'}) {
+            print "Spawned: " . $cmdline . "\n";
+        }
+        Win32::Process::GetExitCode ($self->{PROCESS}, $status);
+        if ($status != $STILL_ACTIVE) {
+            print STDERR "ERROR: Spawn failed for <", $self->{WINDSH}, ">\n";
+            exit $status;
+        }
+        if (defined $ENV{'ACE_TEST_VERBOSE'}) {
+            print "Status: $status\n";
+        }
+        $self->{RUNNING} = 1;
+        $status = $self->TimedWait (3);
+        if (defined $ENV{'ACE_TEST_VERBOSE'}) {
+            print "TimedWait Status: $status\n";
+        }
+        if ($status == -1) {
+            $self->Kill ();
+            # Don't need to Wait since we are on Win32
+        }
+        $self->{RUNNING} = 0;
+        $self->{PROCESS} = undef;
+        $set_vx_defgw = 1;
+        $do_vx_init = 0;
+        
+        sleep($self->{REBOOT_TIME});
+    }
+
+    my $program = $self->Executable ();
+    my $cwdrel = dirname ($program);
+    if (length ($cwdrel) > 0) {
+        $cwdrel = File::Spec->abs2rel( cwd(), $ENV{"ACE_ROOT"} );
+    }
+    else {
+        $cwdrel = File::Spec->abs2rel( $cwdrel, $ENV{"ACE_ROOT"} );
+    }
+    $cwdrel =~ s/\\/\//g;
+    $program = basename($program, ".out");
+    
+    unlink "run_test.vxs";
+    my $oh = new FileHandle();
+    if (!open($oh, ">run_test.vxs")) {
+        print STDERR "ERROR: Unable to write to run_test.vxs\n";
+        exit -1;
+    }
+
+    if ( defined $ENV{"ACE_RUN_VX_TGTSVR_DEFGW"} && $set_vx_defgw ) {
+        print $oh "\n" .
+                "mRouteAdd(\"0.0.0.0\", \"" . $ENV{"ACE_RUN_VX_TGTSVR_DEFGW"} . "\", 0,0,0)\n";
+        $set_vx_defgw = 0;
+    }
+
+    print $oh "\n" .
+              "cd \"" . $ENV{"ACE_ROOT"} . "/" . $cwdrel . "\"\n" .
+              "\@cd \"" . $ENV{"ACE_RUN_VX_TGTSVR_ROOT"} . "/" . $cwdrel . "\"\n" .
+              "putenv(\"TMPDIR=" . $ENV{"ACE_RUN_VX_TGTSVR_ROOT"} . "/" . $cwdrel . "\")\n";
+    
+    if (defined $ENV{'ACE_RUN_VX_CHECK_RESOURCES'}) {
+        print $oh "memShow();\n";
+    }
+    
+    my $length = length ($program) + 2;
+    my $arguments = "";
+    if (defined $self->{ARGUMENTS}) {
+        ($arguments = $self->{ARGUMENTS})=~ s/\"/\\\"/g;
+        $arguments = ",\"" . $arguments . "\"";
+    }
+    print $oh "write(2, \"\\n$program\\n\", $length);\n" .
+              "ld 1,0,\"" . $program . ".out\"\n" .
+              "ace_vx_rc = vx_execae(ace_main" . $arguments . ")\n" .
+              "unld \"" . $program . ".out\"\n" .
+              "exit(ace_vx_rc)\n";
+
+    close($oh);
+
+    my $executable = $self->{WINDSH};
+    if (defined $ENV{'ACE_TEST_VERBOSE'}) {
+        $cmdline = $self->{WINDSH} . " -s run_test.vxs " . $ENV{"ACE_RUN_VX_TGTSVR"};
+        print "$executable $cmdline\n";
+    }
+    else {
+        $cmdline = $self->{WINDSH} . " -q -s run_test.vxs " . $ENV{"ACE_RUN_VX_TGTSVR"};
+
+    }
+    Win32::Process::Create ($self->{PROCESS},
+                            $executable,
+                            $cmdline,
+                            0,
+                            0,
+                            '.');
+
+    Win32::Process::GetExitCode ($self->{PROCESS}, $status);
+
+    if ($status != $STILL_ACTIVE) {
+        print STDERR "ERROR: Spawn failed for <", $cmdline, ">\n";
+        exit $status;
+    }
+
+    $self->{RUNNING} = 1;
+    return 0;
+}
+
+
+# Wait for the process to exit or kill after a time period
+
+sub WaitKill ($)
+{
+    my $self = shift;
+    my $timeout = shift;
+
+    my $status = $self->TimedWait ($timeout);
+
+    if ($status == -1) {
+        print STDERR "ERROR: $self->{EXECUTABLE} timedout\n";
+        $self->Kill ();
+        # Don't need to Wait since we are on Win32
+        
+        $do_vx_init = 1; # force reboot on next run
+    }
+
+    $self->{RUNNING} = 0;
+    
+    return $status;
+}
+
+
+# Do a Spawn and immediately WaitKill
+
+sub SpawnWaitKill ($)
+{
+    my $self = shift;
+    my $timeout = shift;
+
+    if ($self->Spawn () == -1) {
+        return -1;
+    }
+
+    return $self->WaitKill ($timeout);
+}
+
+
+# Kill the process
+
+sub Kill ()
+{
+    my $self = shift;
+
+    if ($self->{RUNNING}) {
+        Win32::Process::Kill ($self->{PROCESS}, -1);
+    }
+
+    $self->{RUNNING} = 0;
+}
+
+
+# Terminate the process and wait for it to finish
+
+sub TerminateWaitKill ($)
+{
+    my $self = shift;
+    my $timeout = shift;
+
+    if ($self->{RUNNING}) {
+        print STDERR "INFO: $self->{EXECUTABLE} being killed.\n";
+        Win32::Process::Kill ($self->{PROCESS}, 0);
+        $do_vx_init = 1; # force reboot on next run
+    }
+
+    return $self->WaitKill ($timeout);
+}
+
+
+# Wait until a process exits.
+# return -1 if the process is still alive.
+
+sub Wait ($)
+{
+    my $self = shift;
+    my $timeout = shift;
+    if (!defined $timeout || $timeout < 0) {
+      $timeout = INFINITE;
+    } else {
+      $timeout = $timeout * 1000 * $PerlACE::ProcessVX::WAIT_DELAY_FACTOR;
+    }
+
+    my $result = 0;
+
+    if ($self->{RUNNING}) {
+      $result = Win32::Process::Wait ($self->{PROCESS}, $timeout);
+      if ($result == 0) {
+        return -1;
+      }
+    }
+    Win32::Process::GetExitCode ($self->{PROCESS}, $result);
+    if ($result != 0) {
+        $do_vx_init = 1; # force reboot on next run
+    }
+    return $result;
+}
+
+
+# Wait for a process to exit with a timeout
+
+sub TimedWait ($)
+{
+    my($self) = shift;
+    my($timeout) = shift;
+    return $self->Wait($timeout);
+}
+
+1;
diff --git a/bin/PerlACE/Process_Win32.pm b/bin/PerlACE/Process_Win32.pm
index 96afbb18934..b644755e99a 100644
--- a/bin/PerlACE/Process_Win32.pm
+++ b/bin/PerlACE/Process_Win32.pm
@@ -1,5 +1,7 @@
 # $Id$
 
+use PerlACE::Run_Test;
+
 package PerlACE::Process;
 
 use strict;
@@ -102,14 +104,18 @@ sub Executable
 
     my $executable = $self->{EXECUTABLE};
 
+    if (PerlACE::is_vxworks_test()) {
+        $executable = PerlACE::VX_HostFile ($executable);
+    }
+    
     if ($self->{IGNOREEXESUBDIR} == 0) {
-      $executable = PerlACE::Process::Normalize_Executable_Name ($executable);
+        $executable = PerlACE::Process::Normalize_Executable_Name ($executable);
     }
     else {
-      $executable = $executable.".EXE";
-      $executable =~ s/\//\\/g; # / <- # color coding issue in devenv
+        $executable = $executable.".EXE";
+        $executable =~ s/\//\\/g; # / <- # color coding issue in devenv
     }
-
+    
     return $executable;
 }
 
diff --git a/bin/PerlACE/Run_Test.pm b/bin/PerlACE/Run_Test.pm
index 9bfd180a712..8304eff2748 100644
--- a/bin/PerlACE/Run_Test.pm
+++ b/bin/PerlACE/Run_Test.pm
@@ -4,11 +4,16 @@
 # startup ARGV processing that is used by all tests.
 
 use PerlACE::Process;
+use PerlACE::ProcessVX;
 use PerlACE::ConfigList;
 
 package PerlACE;
+use File::Spec;
 use Cwd;
 
+my $config = new PerlACE::ConfigList;
+$PerlACE::VxWorks_Test = $config->check_config("VxWorks");
+
 # Figure out the svc.conf extension
 $svcconf_ext = $ENV{"ACE_RUNTEST_SVCCONF_EXT"};
 if (!defined $svcconf_ext) {
@@ -16,7 +21,7 @@ if (!defined $svcconf_ext) {
 }
 
 # Default timeout.  NSCORBA needs more time for process start up.
-$wait_interval_for_process_creation = ($^O eq "nonstop_kernel") ? 10 : 5;
+$wait_interval_for_process_creation = ($^O eq "nonstop_kernel") ? 10 : ($PerlACE::VxWorks_Test ? 60 : 5);
 
 # Turn on autoflush
 $| = 1;
@@ -38,6 +43,13 @@ sub LocalFile ($)
     return $newfile;
 }
 
+sub VX_HostFile($)
+{
+    my $file = shift;
+    $file = File::Spec->rel2abs ($file);
+    $file = File::Spec->abs2rel ($file, $ENV{"ACE_ROOT"});
+    return $ENV{"HOST_ROOT"}."/".$file;
+}
 
 # Returns a unique id, uid for unix, last digit of IP for NT
 sub uniqueid
@@ -77,7 +89,7 @@ sub waitforfile_timed
 {
   my $file = shift;
   my $maxtime = shift;
-  $maxtime *= $PerlACE::Process::WAIT_DELAY_FACTOR;
+  $maxtime *= ($PerlACE::VxWorks_Test ? $PerlACE::ProcessVX::WAIT_DELAY_FACTOR : $PerlACE::Process::WAIT_DELAY_FACTOR);
 
   while ($maxtime-- != 0) {
     if (-e $file && -s $file) {
@@ -129,6 +141,11 @@ sub generate_test_file
   return $file;
 }
 
+sub is_vxworks_test()
+{
+    return $PerlACE::VxWorks_Test;
+}
+
 $sleeptime = 5;
 
 1;