Subversion Repositories DevTools

Rev

Rev 5709 | Blame | Compare with Previous | Last modification | View Log | RSS feed

########################################################################
# COPYRIGHT - VIX IP PTY LTD ("VIX"). ALL RIGHTS RESERVED.
#
# Module name   : jats.sh
# Module type   : Makefile system
# Compiler(s)   : n/a
# Environment(s): jats
#
# Description   : JATS Make Time Test Harness Support
#                 This package contains fucntions that will be used by JATS
#                 to invoke the tests.
#
#                 This is more powerful that the previous shell-based solution
#                 that had problems under windows.
#
#                 The functions are designed to be invoked as:
#                   $(GBE_PERL) -Mjats_runtest -e <function> -- <args>+
#
#                 The functions in this packages are designed to take parameters
#                 from @ARVG as this makes the interface easier to read.
#
#......................................................................#

require 5.006_001;
use strict;
use warnings;

package jats_runtest;

our (@ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS, $VERSION);
use Exporter;
use JatsError qw(:name=jats_runtest);
use Pod::Usage;                             # For help support
use JatsSystem;
#use JatsEnv;
use Getopt::Long;
use FileUtils;

$VERSION = 1.00;
@ISA = qw(Exporter);

# Symbols to autoexport (:DEFAULT tag)
@EXPORT = qw( runtest
            );

#use File::Path qw(rmtree);

BEGIN
{
    print "-------jats_runtest initiated\n";
}

#
#   Options
#
my $opt_debug   = $ENV{'GBE_DEBUG'};        # Allow global debug
my $opt_verbose = $ENV{'GBE_VERBOSE'};      # Allow global verbose
my $opt_help = 0;
my $opt_manual = 0;

my $opt_test_name;              # Text Name of the test
my $opt_interface;              # Path to the interface directory
my $opt_test_dir;               # Path to directory to run the test in
my $opt_platform;               # Current target
my $opt_type;                   # Type [ D or P ]
my $opt_host;                   # Host Machine
my $opt_root;                   # path to build root
my $opt_local_bin;              # Path to local bin directory
my @opt_copy_once;              # File to copy (once) into the test directory
my @opt_copy_in;                # File to copy in each time
my $opt_isa_script;             # Command is a script
my $opt_test_cmd;               # Test command
my @opt_test_args;              # Arguments to be passed to the test

#
#   Globals
#
our $Cwd;

#-------------------------------------------------------------------------------
# Function        : runtest
#
# Description     : Run a test
#
# Inputs          : All arguments are passed as options
#                   test_name               - Text Name of the test
#                   interface               - Path to the interface directory
#                   test_dir                - Path to directory to run the test in
#                   GBE_PLATFORM            - Current target
#                   GBE_TYPE                - Type [ D or P ]
#                   GBE_HOST                - Host Machine
#                   GBE_ROOT                - Abs path to build root
#                   BINDIR_LOCAL_PATH       - Path to local bin directory
#
#                   copy_once               - File to copy (once) into the test directory
#                   copy_in                 - File to copy in each time
#
#                   isa_script              - Command is a script
#                   test_cmd                - Test command
#                   test_args               - Arguments to be passed to the test
#
#   
#
# Returns         : 
#
sub runtest
{
    my $result = GetOptions (
                    "help+"         => \$opt_help,              # flag, multiple use allowed
                    "manual"        => \$opt_manual,            # flag, multiple use allowed
                    "verbose+"      => \$opt_verbose,           # flag, multiple use allowed

                    "test_name=s"      => \$opt_test_name,
                    "interface=s"      => \$opt_interface,
                    "test_dir=s"       => \$opt_test_dir,
                    "platform=s"       => \$opt_platform,
                    "type=s"           => \$opt_type,
                    "host=s"           => \$opt_host,
                    "root=s"           => \$opt_root,
                    "local_bin=s"      => \$opt_local_bin,
                    "copy_once=s"      => \@opt_copy_once,
                    "copy_in=s"        => \@opt_copy_in,
                    "isa_script"       => \$opt_isa_script,
                    "test_cmd=s"       => \$opt_test_cmd,
                    "test_args=s"      => \@opt_test_args,

                    );

                    #
                    #   UPDATE THE DOCUMENTATION AT THE END OF THIS FILE !!!
                    #

    #
    #   Process help and manual options
    #
    pod2usage(-verbose => 0, -message => "Version: $VERSION")  if ($opt_help == 1  || ! $result);
    pod2usage(-verbose => 1)  if ($opt_help == 2 );
    pod2usage(-verbose => 2)  if ($opt_manual || ($opt_help > 2));

    #
    #   Caputure the $Cwd
    #
    InitFileUtils();

    #
    #   Setup the test environment
    #   The following EnvVars are for scripts
    #
    $ENV{GBE_TYPE} = $opt_type;
    $ENV{GBE_HOST} = $opt_host;
    $ENV{GBE_ROOT} = AbsPath($opt_root);

    #
    #   Extend the PATH to pick up utilities that have been placed into the
    #   local/bin directory.
    #
    $ENV{PATH} = AbsPath($opt_local_bin) . $ScmPathSep . $ENV{PATH};


    #
    #   Setup System options
    #
    my @sysopts = '--NoExit';
#    push @sysopts, "--Shell" if ( $opt_isa_script );
    push @sysopts, "$ENV{GBE_BIN}/sh" if ( $opt_isa_script );

    #
    #   Change to the required target directory and execute the command
    #
    chdir $opt_test_dir || Error ("Cannot change directory to $opt_test_dir");
    $result = System ('--Show',@sysopts, $opt_test_cmd, @opt_test_args );
    chdir $Cwd || Error ("Cannot change directory to $Cwd");

    exit $result;
}

1;