Subversion Repositories DevTools

########################################################################

# 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;