WebSVN – DevTools – /core_devl/branches/dpurdie_3.5.10000.cr/TOOLS/LIB/MakeIf.pm

########################################################################
# Copyright (C) 2008 ERG Limited, All rights reserved
#
# Module name   : MakeIf.pm
# Module type   : JATS Internal
# Compiler(s)   : Perl
# Environment(s): JATS
#
# Description   : This modules builds an object that provides
#                 an interface to the underlying toolset
#
#                 It is overly complicated
#
#                       *** DO NOT DETAB ***
#
#......................................................................#

use strict;
use warnings;

#
#   System Globals
#   Declared to avoid compile errors
#
our $ScmVersion;
our $ScmTargetHost;
our @TESTPROJECT_TO_ARUN;
our @TESTPROJECT_TO_URUN;
our $ToolsetPROJECT_type;

###############################################################################
#   MakeInterface ---
#       Interface framework
#
#   Push                Push a package into the interface stack.
#   Factory             Build a interface.
#   Load                Loads the specified interface
#...

package MakeIf;

use strict;
use warnings;

our (@IfStack)              = ();               # interface stack

#-------------------------------------------------------------------------------
# Function        : Makeif::Push
#
# Description     : Push a toolset interface onto a list of such items
#                   Will be used later to construct the toolset interface
#
# Inputs          : *                       - List of packages to push
#
# Returns         : Nothing
#
sub Push
{
    ::Debug( "MakeIf::Push( @_ )" );
    push (@IfStack, @_);                        # push onto stack
}

#-------------------------------------------------------------------------------
# Function        : MakeIf::Factory
#
# Description     : Build a interface.
#                   Creates a Toolset Interface from all the toolsets
#                   that have been pushed on to the list of toolsets
#
#                   The user is provided the reference to the composite
#                   interface created such that it inherits properties from
#                   all the other toolsets
#
# Inputs          : None
#
# Returns         : Refernece to the constructed interface
#
sub Factory
{
    sub Unroll
    {
        my ($stack) = @_;                       # current
        my ($package, $base, $self);

        #
        #   First package on the stack MUST be the BASE_Toolset
        #   This has a 'Spawn' method that must be invoked
        #
        $package = shift(@$stack);              # base class
        ::Error( "Interface -- base-class $package cannot Spawn." )
            unless( $package->can( "Spawn" ));

        $self = $package->Spawn();

        #
        #   Process the remainder of the toolsets on the stack
        #       1) Cause package to inherit previous package stuff
        #       2) Invoke any local conststructor
        #
        while (scalar(@$stack))
        {                                       # child
            my ($has_constructor);

            $base = $package;
            $package = shift(@$stack);

            no strict 'refs';

            ::Warning( "Interface --- base package $base is empty." )
                unless (%{"$base\::"});

            $has_constructor = $package->can( "Constructor" );

            push @{"$package\::ISA"}, $base;    # inherit class(es)
            bless ($self, $package);            # consecrate

            $self->Constructor()                # 'local' constructor
                if ($has_constructor);
        }

        return ($self);
    }

    my (@stack) = @IfStack;                     # clone stack
    my ($self);

    ::Error( "Interface -- object stack empty." )
        if ( ! scalar (@stack) );
    $self = Unroll( \@stack) ||
        ::Error( "Interface --- cannot build interface object." );
#::DebugDumpData("Factory Stack", \@IfStack );
#::DebugDumpData("Factory", $self );
    return $self;
}

#-------------------------------------------------------------------------------
# Function        : MakeIf::Load
#
# Description     : Loads the specified interface
#                   This function will create a new 'class' based on the
#                   data within the DPACKAGE and DPACKAGE.CFG files
#                   within a consumed package
#
#                   The DPACKAGE file should use the 'Interface()' directive
#                   to add the created package onto the Interface list
#
# Inputs          : $dir            - Config directory within the package
#                   $file           - DPACKAGE file within the dir
#                   $dpackage       - Name of the Package containg file to load
#                   $root           - Base directory of the package
#                   $project        - Package project suffix (optional)
#
# Returns         : Nothing
#
sub Load
{
    my ($dir, $file, $dpackage, $root, $project) = @_;

    #
    #   Create the basic template class
    #
    my $if = Template ($dpackage, $project);

    #
    #   Insert essential information into the Interface
    #   Invoke functions within the Interface Class to do this
    #
    $if->setRoot($root);
    $if->ReadFiles( "$dir/DPACKAGE.CFG", "$dir/$file" );
}

#-------------------------------------------------------------------------------
# Function        : Template
#
# Description     : Create a new skeleton template for a toolset interface
#                   package. The details of the package will be beefed out
#                   later
#
# Inputs          : $dpackage       - Name of the Package containg file to load
#                   $project        - Package project suffix (optional)
#
# Returns         : Nothing
#
sub Template
{
    my ($dpackage, $project) = @_;
    my ($package, $template );

    #
    #   The code will not work if dpackage has a "-" in it
    #   Replace nasty characters with nice ones
    #
    $project = '' unless ( $project );
    $dpackage =~ s~-~_~g;
    $package = $dpackage . "_" . $project . "_DPACKAGE";

    $template = (<< '__END_OF_DPACKAGE_TEMPLATE__');
########################################################################
#
#   DPACKAGE Template -- version (1.x)
#
#       Version         State interface version requirements.
#       Using           Using statement.
#       Needs           Pre-req
#       Interface       Push onto the interface stack.
#       Self            Our reference.
#       Package         Package name.
#       Name            Name of perl package.
#       Root            Root directory of our installation.
#       Debug           General purpose debug output.
#
#   Initialisation
#       setRoot         Configure package Root
#       ReadFiles       Read DPACKAGE files into the class
#..
package __PACKAGE__;

use strict;
use warnings;

our $VERSION='1.00';                            # Template version
our $SelfReference;

DPACKAGE_Initialise();

sub DPACKAGE_Initialise {
    my $self = {
            PACKAGE     => "__DPACKAGE__",
            NAME        => "__PACKAGE__",
            ROOT        => "__ROOT__"
        };
    $SelfReference = bless $self, "__PACKAGE__";
}

sub setRoot             { $_[0]->{ROOT} = $_[1]; }
sub Self                { return $SelfReference; }
sub Package             { $SelfReference->{PACKAGE}; }
sub Name                { $SelfReference->{NAME}; }
sub Root                { $SelfReference->{ROOT}; }
sub Interface           { MakeIf::Push( "__PACKAGE__" ); }
sub Debug               { ::Debug @_; }
sub Debug2              { ::Debug2 @_; }
sub Debug3              { ::Debug3 @_; }
sub Error               { ::Error @_; }


sub Version
{
    my ($major, $minor) = @_;
    Error( "DPACKAGE $SelfReference->{PACKAGE} requires Version($major,$minor)" )
        if ($major != 1 || $minor != 0);
}


sub Using
{
    my ($using) = @_;
    $SelfReference->{USING} = $using;
}


sub Needs
{
    my ($name, $version) = @_;

    #   TODO - statement of DPACKAGE prereqs.
    #
    #   name                Package name
    #
    #   Version [optional]
    #       =xx.xx.xx       Absolute
    #       >=xx.xx.xx      Greater or equal.  Where xx respresents
    #                       either, * or missing.
    #...
}


sub IncDir
{
    #TODO
}

sub LibDir
{
    #TODO
}

sub Libraries
{
    my ($caller, $file, $line) = caller();

    Error( "$SelfReference->{PACKAGE} ($line) requires Using()" )
        if ( ! defined( $SelfReference->{USING} ) );

    MakeIf::Libaries( $SelfReference->{USING}, @_ );
}

#
#   Designed to be called externally though the class interface
#   As the first argument is the class ref
#
sub ReadFiles
{
    my $self = shift;
    my $code;
    foreach my $file ( @_ )
    {
        if ( -e $file )
        {
            open(CFGFILE, $file) || Error( "Cannot open '$file'" );
            $code .= "# line 1 " . $file . "\n";    # name the image
            while (<CFGFILE>) {
                $code .= $_;                        # slurp text
            }
            close (CFGFILE);

            #
            #   Add the file to the makefile dependency list
            #   Really only needed if being sourced from within a sandbox
            #
            push (@::ScmDepends, $file);
        }
    }

    #
    #   Evaluate the code
    #
    eval "$code";
    Error("DPACKAGE Syntax. Package: $SelfReference->{ROOT}", "Err: $@" ) if ($@);
}

sub EvaluateText
{
    my $this = shift;
    eval "@_";
    Error("DPACKAGE Syntax. Package: $SelfReference->{ROOT}", "Err: $@" ) if ($@);
}

###########################################################################
#   -END-
#
__END_OF_DPACKAGE_TEMPLATE__

    $template =~ s/__PACKAGE__/$package/g;      # preprocess template
    $template =~ s/__DPACKAGE__/$dpackage/g;

    #
    #   Have the template for the class in a text string
    #   Create it at run-time
    #
    my $if = eval "# line 1 \"DPACKAGE_TEMPLATE\"\n".   # name the image
         "$template";                                   # .. template code
    ::Error("JATS INTERNAL. MakeIf Template", "Err: $@" )
        if ($@);
    return $if;
}

###############################################################################
#   DPACKAGE Interface
#
#       PackageLoad     Load the DPACKAGES for specified platform(s).
#
#       PackageDirs     Retrieve the search path for package configuration.
#
#       LibUsing        Processing Using(XXX) library recipes
#
#       LibProcess      Apply library ordering rules.
#
#       ExportDepend    Export a local package dependency list.
#..

our %IfPkgLibaries        = ();
our %IfPkgOrdering        =
        (
            'User'      => '0',                 # User (default)

            'App'       => '3',                 # Application common
            'App2'      => '3a',
            'App3'      => '3b',
            'App4'      => '3c',

            'If'        => '5',                 # Interface
            'If2'       => '5a',
            'If3'       => '5b',
            'If4'       => '5c',

            'Kern'      => '7',                 # Kernel (ie MOS, LMOS)
            'Kern2'     => '7a',
            'Kern3'     => '7b',
            'Kern4'     => '7c',

            'Sys'       => '9',                 # System (ie WIN32, Linux)
            'Sys2'      => '9a',
            'Sys3'      => '9b',
            'Sys4'      => '9c'
        );

#
#   Provide reverse lookup of the %IfPkgOrdering for error reporting purposes
#   It may be slow, but its not used (Often).
#
sub ClassNumToText
{
    my (@classes) = @_;
    my @result;

    foreach my $class ( @classes )
    {
        my $result = "Unknown Class($class)";
        foreach ( keys %IfPkgOrdering )
        {
            if ( $IfPkgOrdering{$_} eq $class )
            {
                $result = $_;
                last;
            }
        }
        push @result, $result;
    }
    return @result;
}

#-------------------------------------------------------------------------------
# Function        : PackageLoad
#
# Description     : Scan all external packages and locate DPACKAGE files
#                   This will (must) be in the JATS config directory (gbe)
#
#                   Once found they will be loaded into the system
#                   This will effectivly extend the base toolset
#
# Inputs          : $platform               - target platform
#                                             Only used to locate packages
#                                             Not 'really' used
#
# Returns         : Nothing
#
sub PackageLoad
{
    my ($platform) = @_;
    ::Debug ("PackageLoad", @_);

    return if ( !(%::ScmBuildPkgRules) );# configuration available

    my $pPlatform = $::ScmBuildPkgRules{$platform};
    foreach my $package ( @{$pPlatform} )
    {
        if ( defined( $package->{'CFGDIR'} ) )
        {
            my ($dir) = $package->{'ROOT'}.$package->{'CFGDIR'};

            #
            #   Look for both forms:
            #       DPACKAGE.GBE_MACHTYPE   ( New format )
            #       DPACKAGE                ( Manually created and Old format )
            #   Use only the first
            #
            foreach my $ext ( '.' . $::GBE_MACHTYPE, '' )
            {
                my $dpackage = "DPACKAGE" . $ext;
                ::Debug( "Examine $dir/$dpackage" );
                if ( -e "$dir/$dpackage" )
                {                                   # .. load interface
                    ::Debug( "Loading $dir/$dpackage ($package->{'NAME'}) ..." );
                    MakeIf::Load( $dir, $dpackage, $package->{'NAME'}, $package->{'ROOT'}, $package->{'DPROJ'} );
                    last;
                }
            }
        }
    }
}

#-------------------------------------------------------------------------------
# Function        : PackageDirs
#
# Description     : Extend an array of 'search' directories to include
#                   'gbe' extension directories located with external toolsets
#
#                   Scan the package information held in ScmBuildPkgRules
#                   and locate 'gbe' directories.
#
# Inputs          : $dirs       - Ref to an array to extend
#                   @platforms  - A list of platforms to scan
#
# Returns         : Nothing
#
sub PackageDirs
{
    my ($dirs, @platforms) = @_;

    if ( (%::ScmBuildPkgRules) )
    {
        for my $platform (@platforms)
        {
            my $pPlatform = $::ScmBuildPkgRules{$platform};

            foreach my $package ( @$pPlatform )
            {
                push @$dirs, $package->{'ROOT'}.$package->{'CFGDIR'}
                    if ( defined( $package->{'CFGDIR'} ) );
            }
        }
    }
}

#-------------------------------------------------------------------------------
# Function        : MakeIf::Libaries
#
# Description     : Maintain a data structure for the --Using() expansion
#
# Inputs          : $using              - Name of the Macro
#                   $platform           - Active platform predicate
#                   @libs               - List of Libraries
#
# Returns         : Nothing
#
sub Libaries
{
    my ($using, $platforms, @libs) = @_;
    my $recipe;

    ::Debug2( "Makeif::Libraries($using, $platforms, @libs)" );
    return if ( ! ::ActivePlatform($platforms) );

    push @{$IfPkgLibaries{$using}{LIBS}}, @libs;
}


#private
sub LibUsing
{
    my ($caller, $args, $libs) = @_;
    my ($using, @args) = split( ',', $args );

    ::Debug2( "Makeif::LibUsing($caller->$args)" );

    # Global arguments (if any)
    #
    #   ie. --Using(XXX)[,--NoWarn][,--ifdef USING_XXX]
    #
    my ($x_nowarn, $x_conds) = (0, 0);

    foreach (@args) {
        if ( /^--NoWarn$/ ) {                   # .. disable warnings
            $x_nowarn = 1;

        } elsif ( /^--if(.*)$/ ) {              # .. conditional(s)
            $x_conds .= "," if ($x_conds);
            $x_conds .= $_;

        } else {
            ::Warning( "$caller->Using($using), unknown option '$_'" );
        }
    }


    # Sanity test
    #   Recipe Entry Must Exist
    #   Detect recursive invocation
    #
    my $recipe = $IfPkgLibaries{$using};
    unless ( $recipe )
    {
        ::Warning( "$caller->Using($using), module not found" )
            unless ( $x_nowarn );
        return;
    }

    if ( $recipe->{COOKED} ) {
        ::Warning( "$caller->Using($using) causes loop, ignored" )
            unless ($recipe->{COOKED_ERR} );
        $recipe->{COOKED_ERR}++;
        return;
    }

    # Parse Using arguments
    my ($arg, $deforder, $defallowdup, $defnowarn, @defconds);
    $deforder = "User";                 # default "class"
    $defallowdup = 0;
    $defnowarn = 0;

    foreach (@{$recipe->{LIBS}})
    {
        # Locally processed switches (global/default settings)
        #
        if ( /^--DefOrder=(.*)$/ ) {
            $deforder = $1;             # Sort using name
            next;
        }
        if ( /^--DefAllowDup$/ ) {
            $defallowdup = 1;
            next;
        }
        if ( /^--DefNoWarn$/ ) {
            $defnowarn = 1;
            next;
        }

        if ( /^--DefCond\((.*)\)$/ ) {
            my (@conds) = split( ',', $1 );

            @defconds = ();
            foreach (@conds) {
                Error( "Invalid --DeCond argument '$_' " )
                    if ( ! /^--if/ );
                push @defconds, $_;
            }
            next;
        }

        # Handle indirections
        #
        if ( /^--Using\((.*)\)(.*)$/ )
        {                               # recurse
            my ($x_using);

            $x_using  = "$1";
            $x_using .= ",$x_conds"     if ( $x_conds );
            $x_using .= "$2";

            $recipe->{COOKED}++;
            LibUsing( $using, $x_using, $libs );
            $recipe->{COOKED}--;
            next;
        }

        # Libraries and arguments
        #
        if ( /^-[lL].*/ )
        {                               # Library
            my ($order, $allowdup, $nowarn, @conds) =
                ($deforder, $defallowdup, $defnowarn, @defconds);
            my (@args) = split( ',', $_ );

            foreach (@args) {
                if ( /^-([lL])(.*)/ ) {
                    $arg = $_;
                } elsif ( /^--Order=(.*)/ ) {
                    $order = $1;
                } elsif ( /^--AllowDup$/ ) {
                    $allowdup = 1;
                } elsif ( /^--NoAllowDup$/ ) {
                    $allowdup = 0;
                } elsif ( /^--NoWarn$/ ) {
                    $nowarn = 1;
                } elsif ( /^--Warn$/ ) {
                    $nowarn = 0;
                } elsif ( /^--if/ ) {
                    push @conds, $_;
                } else {
                    $arg .= $_;         # unknown
                }
            }

            $arg .= ",--Order=$order"       if ( $order );
            $arg .= ",--NoWarn"             if ( $nowarn );
            $arg .= ",--AllowDup"           if ( $allowdup );
            $arg .= ",$x_conds"             if ( $x_conds );
            $arg .= ",". join(',', @conds)  if ( @conds );
        }
        else
        {                               # other options etc
            $arg = $_;
        }

        push @$libs, $arg;              # push cooked argument
    }
}


sub LibProcess
{
    my ($libs) = @_;
    my (@newlibs, @ordered_newlibs);
    my ($order, @cond, %librecipes, %libstatus);

    #
    #   Only process the library specification if arguments/attributes
    #   are encountered .. compat with older makefile's.
    #
    my ($attrs) = 0;

    #   use Data::Dumper;
    #   $Data::Dumper::Purity = 1;
    #   ::Debug "# Uncooked library list";
    #   ::Debug Dumper( $libs );

    $order = 1;                                 # physical order start @ 1
    @cond = ();

    foreach (@$libs)
    {
        my ($libname, $class, $fdup, $fnowarn, @params);

        $libname = "";                          # library name and class
        $class = "User";                        # deafult class
        $fdup = 0;                              # default, remove duplicates
        $fnowarn = 0;

        if ( /^--if(.*)/ )
        {                                       # Conditional (for next)
            ::Warning( "Stray --if '$1' within library specification -- ignored" )
                if ( @cond );
            @cond = ( $_ );
            $attrs++;
            next;
        }

        if ( /^-[lL].*/ )
        {                                       # Library
            my (@args) = split( ',', $_ );      # split specification

            foreach (@args) {
                if ( /^-([lL])(.*)/ ) {         # Library
                    if ( $::ScmTargetHost eq "Unix" ) {
                        $libname = "lib$2";     # .. prefix lib
                        $libname =~ s/^liblib/lib/;
                    } else {
                        $libname = $2;          # .. just stripped name
                    }
                    $libname .= "\$(GBE_TYPE)"  # .. append GBE_TYPE
                        if ( $1 eq "l" );

                    push @params, $libname;

                } else {                        # Attribute/options
                    if ( /^--Order=(.*)/ ) {    # .. sort using 'class'
                        if ( exists $IfPkgOrdering{$1} )
                        {
                            $class = $1;
                        }
                        else
                        {
                            ::Warning( "Lib '$libname' has unknown class '$1'" );
                        }


                    } elsif ( /^--AllowDup$/ ) {# .. allow duplicate images
                        $fdup = 1;

                    } elsif ( /^--NoWarn$/ ) {  # .. disable warnings
                        $fnowarn = 1;

                    } elsif ( /^--if(.*)/ ) {   # .. conditional(s)
                        push @cond, $_;

                    } else {                    # .. other "parameters"
                        push @params, $_;
                    }

                    $attrs++;
                }
            }

            #
            #   Convert text class name to an ordered number to assist in sorting
            #
            $class = $IfPkgOrdering{ $class };
        }
        else
        {                                       # Anything else
            push @params, $_;
        }

        my ($recipe) = {
                CLASS   => $class,              # logical class, prim key
                ORDER   => $order,              # physical order, 2nd key
                LIBNAME => $libname,            # library name (if any)
                FDUP    => $fdup,               # duplicate flag
                FNOWARN => $fnowarn,            # no-warning flag
                CONDS   => [ @cond ],           # optional conditional(s)
                PARAMS  => [ @params ],         # parameters
            };

        push @newlibs, $recipe;                 # push recipe
        push @{$librecipes{$libname}}, $recipe  # plus index using $name
            if ( $libname ne "" );

        @cond = ();
        $order++;
    }

    #   ::Debug3 "# Cooked library list";
    #   ::Debug3 Dumper( @newlibs );

#   Parse the library list and determine the status and correct
#   handling of any duplicate images.
#..
    foreach my $name (keys %librecipes)
    {
        if ( scalar( @{$librecipes{$name}} ) > 1 )
        {
            my ($class, $classerr, $dup, $nowarn);

            foreach my $recipe (@{$librecipes{$name}})
            {
                $classerr = 1                   # test for conflicts
                    if ( defined($class) && $class ne $recipe->{CLASS} );

                $class = $recipe->{CLASS};

                $dup = $recipe->{FDUP}          # accumulate
                    if ( !defined($dup) || $recipe->{FDUP} );

                $nowarn = $recipe->{FNOWARN}    # accumulate
                    if ( !defined($nowarn) || $recipe->{FNOWARN} );
            }

            my ($stat) = {};

            $stat->{SEEN} = 0;
            $stat->{DUP} = $dup;
            $stat->{NOWARN} = $nowarn;
            $stat->{CLASSERR} = 1 if (defined($classerr));
            $libstatus{$name} = $stat;
        }
    }

#   Sort the library list
#
    @ordered_newlibs =                          # sort by class/order
        sort {
            ($a->{CLASS} ne "" && $b->{CLASS} ne "" &&
                    $a->{CLASS} cmp $b->{CLASS}) ||
            $a->{ORDER} <=> $b->{ORDER}
        } @newlibs;

    #   ::Debug3 "# Sorted library list";
    #   ::Debug3 Dumper( @ordered_newlibs );

#   Now built the final list, removing duplicates (if required)
#
    @$libs = ();                                # zap libraries

    foreach my $newlib (@ordered_newlibs)
    {
        my ($name) = $newlib->{LIBNAME};

        if ($attrs && defined($libstatus{$name}))
        {                                       # two or more entries
            my ($stat) = $libstatus{$name};

            if ( $stat->{SEEN}++ == 0 )
            {                                   # first image
                if ( ! $stat->{NOWARN} )
                {                               # .. warnings ?
                    if ( defined($stat->{CLASSERR}) )
                    {                           # .. class conflict
                        my (@classes);

                        foreach my $recipe (@{$librecipes{$name}}) {
                            ::UniquePush( \@classes, $recipe->{CLASS} );
                        }
                        ::Warning( "Lib '$name' has multiple classes\n\t" .
                            ::CommifySeries( ClassNumToText(@classes) ) );
                    }

                    my ($count) = scalar( @{$librecipes{$name}} );

                    ::Warning( "Lib '$name' appeared $count times, ".
                               "duplicate" . ($count > 2 ? "s":""). " removed" )
                        if ($stat->{DUP} == 0);
                }
            }
            else
            {                                   # remove duplicate(s) ?
                next if ($stat->{DUP} == 0);
            }
        }

        my ($spec);

        $spec = join( ',', @{$newlib->{PARAMS}} );
        $spec .= "\n\t\t" . join( "\n\t\t", @{$newlib->{CONDS}} )
            if ( @{$newlib->{CONDS}} );

        push @$libs, $spec;
    }

    #   ::Debug "# Final library list";
    #   ::Debug Dumper( $libs );
}


sub ExportDepend
{
    #
    #   Create the dependancy data structure
    #   Its easier to dump a complete structure
    #
    my %ScmBuildPkgDepend;
    foreach my $platform ( keys %::ScmBuildPkgRules )
    {
        foreach my $package ( @{$::ScmBuildPkgRules{$platform}} )
        {
            my %entry;
            $entry{NAME}        = $package->{'NAME'};
            $entry{VERSION}     = $package->{'VERSION'};
            $entry{DNAME}       = $package->{'DNAME'};
            $entry{DVERSION}    = $package->{'DVERSION'};
            $entry{DPROJ}       = $package->{'DPROJ'};

            push @{$ScmBuildPkgDepend{$platform}}, \%entry;
        }
    }


    my $fh = ::ConfigurationFile::New( "DPACKAGE.CFG" );
    $fh->Header( "makelib (Version $::ScmVersion)",
                                "DPACKAGE configuration file" );
    $fh->DumpData(
        "# Dependancy list.\n#\n",
        "ScmBuildPkgDepend", \%ScmBuildPkgDepend );

    $fh->Close(1);
}


###############################################################################
#   BASE_Toolset ---
#       Default interface.
#
#..

package BASE_Toolset;

MakeIf::Push( "BASE_Toolset" );                 # root of object stack

sub Spawn
{
    my ($obclass) = shift;
    my ($class) = ref($obclass) || $obclass;
    my ($self) = {};

    ::Debug2( "\tBASE_Toolset->Spawn()" );
    bless($self, $class);
    return ($self);
}


sub Preprocess
{
    my ($self) = shift;

    ::Debug2( "BASE_Toolset->Preprocess()" );
    ::ToolsetPreprocess()                       # optional toolset interface
        if ( defined &::ToolsetPreprocess );
}


sub Postprocess
{
    my ($self) = shift;

    ::Debug2( "BASE_Toolset->Postprocess()" );
    ::ToolsetPostprocess()                      # optional toolset interface
        if ( defined &::ToolsetPostprocess );
}


sub CTAGS
{
    ::ToolsetCTAGS()                            # optional toolset interface
        if ( defined &::ToolsetCTAGS );
}


sub CCDepend
{
    my ($self) = shift;

    ::Debug2( "BASE_Toolset->CCDepend()" );
    ::Error ("BASE_Toolset does not support C file dependency generation" )
        unless ( defined &::ToolsetCCDepend );
    ::ToolsetCCDepend( @_ );                    # toolset
}


sub CXXDepend
{
    my ($self) = shift;

    ::Debug2( "BASE_Toolset->CXXDepend()" );
    ::Error ("BASE_Toolset does not support C++ dependency generation" )
        unless ( defined &::ToolsetCXXDepend );
    ::ToolsetCXXDepend( @_ );                   # toolset
}


sub CC
{
    my ($self) = shift;
    my ($source, $obj, $pArgs) = @_;

    ::Debug2( "BASE_Toolset->CC($source)" );
    ::Error ("BASE_Toolset does not support C compilation" )
        unless ( defined &::ToolsetCC );
    ::ToolsetCC( @_ );                          # toolset
}


sub CXX
{
    my ($self) = shift;
    my ($source, $obj, $pArgs) = @_;

    ::Debug2( "BASE_Toolset->CXX($source)" );
    ::Error ("BASE_Toolset does not support C++ compilation" )
        unless ( defined &::ToolsetCXX );
    ::ToolsetCXX( @_ );                         # toolset
}


sub AS
{
    my ($self) = shift;
    my ($source, $obj, $pArgs) = @_;

    ::Debug2( "BASE_Toolset->AS($source)" );
    ::Error ("BASE_Toolset does not support assembler files" )
        unless ( defined &::ToolsetAS );
    ::ToolsetAS( @_ );                          # toolset
}


sub EXT
{
    my ($self) = shift;

    ::Debug2( "BASE_Toolset->EXT()" );
    return ::ToolsetEXT( @_ )                   # optional toolset interface
        if ( defined &::ToolsetEXT );
    return 0;                                   # default not supppored
}


sub AR
{
    my ($self) = shift;
    my ($name, $pArgs, $pObjs) = @_;

    ::Debug2( "BASE_Toolset->AR($name)" );
    ::Error ("BASE_Toolset does not support library files" )
        unless ( defined &::ToolsetAR );

    ProcessArgs ( "", @_ );                     # Proccess arguments
    ::ToolsetAR( @_ );                          # toolset
}


sub ARLINT
{
    my ($self) = shift;
    my ($name, $pArgs, $pObjs) = @_;

    my ($lname) = "\$(LIBDIR)/$name\$(GBE_TYPE)";
    my ($ltarget) = "lib_$name\_lint";
    my (@LIBCSRC, @LIBCXXSRC) = ();
    my ($srcfile) = "";

    ::Debug2( "BASE_Toolset->ARLINT($name)" );
    ::Error ("BASE_Toolset does not support library files" )
        unless ( defined &::ToolsetAR );

    foreach (@$pObjs) {
        $_ =~ s/^\$\(OBJDIR\)\///g;             # remmove OBJDIR

        if ( ($srcfile = $::OBJSOURCE{ $_ }) )
        {
            my( $quoted_srcfile ) = quotemeta( $srcfile );

            if ( grep /^$quoted_srcfile$/, @::CSRCS ) {
                push( @LIBCSRC, $srcfile );

            } elsif ( grep /^$quoted_srcfile$/, @::CXXSRCS ) {
                push( @LIBCXXSRC, $srcfile );

            }
        }
    }

    ::MakePrint(  "
#.. Lint library ($name)

.PHONY:         $ltarget
$ltarget:       LIBBASE = $name
$ltarget:       LIBNAME = $lname
" );

    ::MakeDefEntry ( "$ltarget:","LIBCSRC =", \@LIBCSRC );
    ::MakeDefEntry ( "$ltarget:","LIBCXXSRC =", \@LIBCXXSRC );

    if ( defined ( &::ToolsetARLINT ) ) {
        ::MakePrint( "$ltarget:" );
        ::ToolsetARLINT( $name, $pArgs, $pObjs, $ltarget, \@LIBCSRC, \@LIBCXXSRC );

    } else {
        ::MakePrint( "$ltarget: \
        \@echo [\$(LIBNAME)] linting not supported..\n" );
    }

    ::MakePrint( "\n" );
}


sub ARMerge
{
    my ($self) = shift;
    my ($name, $pArgs, $pLibs) = @_;

    ::Debug2( "BASE_Toolset->ARMERGE($name)" );
    ::Error ("BASE_Toolset does not support library file merging" )
        unless ( defined &::ToolsetARMerge );
    ::ToolsetARMerge( @_ );                     # toolset
}


sub SHLD
{
    my ($self) = shift;
    my ($name, $pArgs, $pObjs, $pLibs) = @_;
    my ($i);

    ::Debug2( "BASE_Toolset->SHLD($name)" );
    ::Error ("BASE_Toolset does not support shared libraries" )
        unless ( defined &::ToolsetSHLD );

    ProcessArgs ( 'Using', @_ );                # Proccess arguments

    MakeIf::LibProcess( $pLibs );               # cook libraries

    ::Debug3( " args: @$pArgs" );
    ::Debug3( " objs: @$pObjs" );
    ::Debug3( " libs: @$pLibs" );

    ::ToolsetSHLD( @_ );                        # toolset
}


sub SHLDLINT
{
    my ($self) = shift;
    my ($name, $pArgs, $pObjs, $pLibs) = @_;

    my ($lname) = "\$(LIBDIR)/$name\$(GBE_TYPE)";
    my ($ltarget) = "shlib_$name\_lint";
    my (@SHLIBCSRC, @SHLIBCXXSRC) = ();
    my ($srcfile) = "";

    ::Debug2( "BASE_Toolset->SHLDLINT($name)" );
    ::Error ("BASE_Toolset does not support shared libraries" )
        unless ( defined &::ToolsetSHLD );

    foreach (@$pObjs) {
        $_ =~ s/^\$\(OBJDIR\)\///g;             # remmove OBJDIR

        if ( ($srcfile = $::OBJSOURCE{ $_ }) )
        {
            my( $quoted_srcfile ) = quotemeta( $srcfile );

            if ( grep /^$quoted_srcfile$/, @::CSRCS ) {
                push( @SHLIBCSRC, $srcfile );

            } elsif ( grep /^$quoted_srcfile$/, @::CXXSRCS ) {
                push( @SHLIBCXXSRC, $srcfile );

            }
        }
    }

    ::MakePrint(  "
#.. Lint shared library ($name)

.PHONY:         $ltarget
$ltarget:       SHLIBBASE = $name
$ltarget:       SHLIBNAME = $lname
" );

    ::MakeDefEntry ( "$ltarget:","SHLIBCSRC =", \@SHLIBCSRC );
    ::MakeDefEntry ( "$ltarget:","SHLIBCXXSRC =", \@SHLIBCXXSRC );

    if ( defined ( &::ToolsetSHLDLINT ) ) {
        ::MakePrint( "$ltarget:" );
        ::ToolsetSHLDLINT( $name, $pArgs, $pObjs, $pLibs, $ltarget, \@SHLIBCSRC, \@SHLIBCXXSRC );

    } else {
        ::MakePrint( "$ltarget: \
        \@echo [\$(SHLIBNAME)] linting not supported..\n" );
    }

    ::MakePrint( "\n" );
}


sub LD
{
    my ($self) = shift;
    my ($name, $pArgs, $pObjs, $pLibs) = @_;
    my ($i);

    ::Debug2( "BASE_Toolset->LD($name)" );
    ::Error ("BASE_Toolset does not support program generation" )
        unless ( defined &::ToolsetLD );

    ProcessArgs ( 'Using', @_ );                # Proccess arguments

    MakeIf::LibProcess( $pLibs );               # cook libraries

    ::Debug3( " args: @$pArgs" );
    ::Debug3( " objs: @$pObjs" );
    ::Debug3( " libs: @$pLibs" );

    ::ToolsetLD( @_ );                          # toolset
}


sub LDLINT
{
    my ($self) = shift;
    my ($name, $pArgs, $pObjs, $pLibs) = @_;

    my ($pname) = "\$(BINDIR)/$name";
    my ($ptarget) = "prog_$name\_lint";
    my (@PROGCSRC, @PROGCXXSRC) = ();
    my ($srcfile) = "";

    ::Debug2( "BASE_Toolset->LDLINT($name)" );
    ::Error ("BASE_Toolset does not support program generation" )
        unless ( defined &::ToolsetLD );

    foreach (@$pObjs) {
        $_ =~ s/^\$\(OBJDIR\)\///g;             # remmove OBJDIR

        if ( ($srcfile = $::OBJSOURCE{ $_ }) )
        {
            my( $quoted_srcfile ) = quotemeta( $srcfile );

            if ( grep /^$quoted_srcfile$/, @::CSRCS ) {
                push( @PROGCSRC, $srcfile );

            } elsif ( grep /^$quoted_srcfile$/, @::CXXSRCS ) {
                push( @PROGCXXSRC, $srcfile );

            }
        }
    }

    ::MakePrint(  "
#.. Lint program ($name)

.PHONY:         $ptarget
$ptarget:       PROGBASE = $name
$ptarget:       PROGNAME = $pname
" );

    ::MakeDefEntry ( "$ptarget:","PROGCSRC =", \@PROGCSRC );
    ::MakeDefEntry ( "$ptarget:","PROGCXXSRC =", \@PROGCXXSRC );

    if ( defined ( &::ToolsetLDLINT ) ) {
        ::MakePrint( "$ptarget:" );
        ::ToolsetLDLINT( $name, $pArgs, $pObjs, $pLibs, $ptarget, \@PROGCSRC, \@PROGCXXSRC );

    } else {
        ::MakePrint( "$ptarget: \
        \@echo [\$(PROGNAME)] linting not supported..\n" );
    }

    ::MakePrint( "\n" );
}


#-------------------------------------------------------------------------------
# Function        : PreprocessTests
#
# Description     : Invoke the underlying toolset functions to construct the 
#                   rules to be run before any test runs.
#
# Inputs          : 
#
# Returns         :
#
sub PreprocessTests
{
    if ( defined &::ToolsetPreprocessTests )
    {
        ::ToolsetPreprocessTests( );
    }

    ::MakePrint( "\n" );
}

#-------------------------------------------------------------------------------
# Function        : PostprocessTests
#
# Description     : Invoke the underlying toolset functions to construct the 
#                   rules to be run after all tests run.
#
# Inputs          : 
#
# Returns         :
#
sub PostprocessTests
{
    if ( defined &::ToolsetPostprocessTests )
    {
        ::ToolsetPostprocessTests( );
    }

    ::MakePrint( "\n" );
}

#-------------------------------------------------------------------------------
# Function        : CollateTestResults
#
# Description     : Invoke the underlying toolset functions to construct the 
#                   rules to be run after all test postprocessors have completed.
#
# Inputs          : 
#
# Returns         :
#
sub CollateTestResults
{
    if ( defined &::ToolsetCollateTestResults )
    {
        ::ToolsetCollateTestResults( );
    }

    ::MakePrint( "\n" );
}

#-------------------------------------------------------------------------------
# Function        : PROJECT
#
# Description     : Invoke the underlying toolset functions to construct a
#                   project
#
# Inputs          : $pProject       - Reference to the project data
#
# Returns         :
#
sub PROJECT
{
    my( $self, $pProject) = @_;
    my $name = $pProject->{name};

    ::Debug2( "BASE_Toolset->PROJECT($name)" );
    ::Error ("BASE_Toolset does not support Project generation" )
        unless ( defined &::ToolsetPROJECT );

    #
    #   Sanity test the Toolset PROJECT
    #   Only the JAVA toolset will handle ANT projects
    #
    my $ptype = $pProject->{type} ;
    if ( $ptype )
    {
        my $type = $::ToolsetPROJECT_type || '';
        ::Error ("BASE_Toolset does not support Project generation of type: $ptype " )
            unless ( $type eq $ptype );
    }

    #
    #   Generate Phony target names
    #   The toolset MUST provide the targets
    #
    ::MakePrint( "PHONY:\tProjectClean_$name\n" );
    ::MakePrint( "PHONY:\tProject_$name\n" );
    ::MakePrint( "PHONY:\tProjectATest_$name\n" ) if ($pProject->{'autotest'});
    ::MakePrint( "PHONY:\tProjectUTest_$name\n" ) if ($pProject->{'unittest'});
    ::MakePrint( "\n" );

    #
    #   Projects may be specific to debug or production
    #
    my $conditional;
    $conditional = 'ifeq'  if ($pProject->{'Debug'});
    $conditional = 'ifneq' if ($pProject->{'Prod'});
    if ( $conditional )
    {
        ::MakePrint( "$conditional \"\$(DEBUG)\" \"1\"\n" );
    }

    #
    #   Invoke toolset specific function to create the desired targets
    #
    ::ToolsetPROJECT( $pProject->{name},
                      $pProject->{project},
                      $pProject->{options},
                      $pProject->{'autotest'},
                      $pProject->{'unittest'},
                      $pProject->{'generated'}
                       );

    #
    #   Complete any conditional process
    #
    if ( $conditional )
    {
        ::MakePrint( "else\n\n" );
        ::MakePrint( "ProjectClean_$name:\n" );
        ::MakePrint( "Project_$name:\n" );
        ::MakePrint( "ProjectATest_$name:\n" ) if ($pProject->{'autotest'});
        ::MakePrint( "ProjectUTest_$name:\n" ) if ($pProject->{'unittest'});
        ::MakePrint( "\nendif\n" );
    }

    #
    #   If this project does contain a unit test, then the name of the target
    #   that will run the unit test must be added to a list
    #
    push @::TESTPROJECT_TO_ARUN, "ProjectATest_$name" if ($pProject->{'autotest'});
    push @::TESTPROJECT_TO_URUN, "ProjectUTest_$name" if ($pProject->{'unittest'});
}


#-------------------------------------------------------------------------------
# Function        : TESTFRAMEWORK
#
# Description     : Invoke the underlying toolset functions to construct a
#                   Test Frame Work
#
#                   Done by manipulating entries in the HASH that is passed
#                   into the FrameWork Support functionn
#
# Inputs          : $pEntry       - Reference to the test data
#
# Returns         :
#
sub TESTFRAMEWORK
{
    my( $self, $pEntry, @args) = @_;
    my $name = $pEntry->{framework};
    my $fnc = 'ToolsetTESTFRAMEWORK_'. uc($name);
    my $fref = UNIVERSAL::can ( '::main', $fnc );
    ::Debug2( "BASE_Toolset->TestFrameWork($name)" );
    ::Error ("BASE_Toolset does not support Test Frame Work generation: $name" )
        unless ( $fref );

    &$fref( $pEntry, @args );          # Invoke the Function
}

#sub LDUsing
#{
#    my ($self) = shift;
#    my ($using, $name, $isshared, $pObjs, $pLibs) = @_;
#
#    ::Debug2( "BASE_Toolset->LDUsing($using, $isshared, $name)" );
#
#    MakeIf::LibUsing( $name, $using, $pLibs );
#}

#-------------------------------------------------------------------------------
# Function        : ProcessArgs
#
# Description     : Process arguments for the program and library building commands
#                   Processes options:
#                       --Using(XXX),[options]
#                       --Exclude(XXX,XXX,XXX)
#                       --ExcludeLIB(XXX,XXX,XXX)
#
# Inputs          : $mode       - Using == Allow 'Using'
#                   $name       - Name of the program/library
#                   $pArgs      - Ref to an array of arguments
#                   $pObjs      - Ref to an array of objects
#                   $pLibs      - Ref to an array of libraries (Optional)
#
#                   Note: Argument order to assist caller
#
# Returns         : Nothing directly
#                   Massages arrays directly
#
sub ProcessArgs
{
    my ($mode, $name, $pArgs, $pObjs, $pLibs) = @_;
    ::Debug2( "BASE_Toolset->ProcessArgs(@$pArgs)" );

    my @rArgs;

    my $i;
    for ($i = 0; $i < scalar @$pArgs; $i++)
    {
        $_ = $pArgs->[$i];

        if ( $mode && /^--Using\((.*)\)(.*)$/)  # --Using(XXX)[,options]
        {
            MakeIf::LibUsing( $name, "$1$2", $pLibs );

#::DebugDumpData("IfPkgLibaries",\%IfPkgLibaries );
#::DebugDumpData("pLibs",\$pLibs );
        }
        elsif (/^--Exclude\((.*)\)$/)           # --Exclude(Obj,Obj...)
        {
            #
            #   Exclude specified object files
            #   Note: Maintain the order of the object files
            #
            my %exclude;
            my @retain = ();

            @exclude{split( ',', $1 )} = ();

            foreach (@$pObjs)
            {
                (my $objfile = $_) =~ s~.*/~~;  # Remove Shared lib object directory

                push @retain, $_
                    unless (exists $exclude{$objfile} );
            }
            @$pObjs = @retain;
            ::Debug3( "BASE_Toolset->ProcessArgs. OBJS: @retain)" );
        }
        elsif (/^--ExcludeLib\((.*)\)$/)        # --ExcludeLib(Lib,Lib...)
        {
            #
            #   Exclude specified library files
            #   Note: Maintain the order of the library files
            #
            my %exclude;
            my @retain_libs = ();

            @exclude{split( ',', $1 )} = ();

            foreach (@$pLibs)
            {
                m~-[Ll]([^,]*)~;                # Extract library name
                my $libfile = $1;
                push @retain_libs, $_
                    unless (exists $exclude{$libfile} );
            }
            @$pLibs = @retain_libs;
            ::Debug3( "BASE_Toolset->ProcessArgs. LIBS: @retain_libs)" );
        }
        else
        {
            #
            #   Unknown option
            #   Retain to be processed later
            #
            push @rArgs, $_;
        }
    }

    #
    #   Pass unprocessed arguments back to the user
    #
    @$pArgs = @rArgs;
}

1;
Subversion Repositories DevTools

(root)/core_devl/branches/dpurdie_3.5.10000.cr/TOOLS/LIB/MakeIf.pm – Rev 4836
