build/new/property.jam

#  Copyright (C) Vladimir Prus 2002. Permission to copy, use, modify, sell and
#  distribute this software is granted provided this copyright notice appears in
#  all copies. This software is provided "as is" without express or implied
#  warranty, and with no claim as to its suitability for any purpose.

import feature ;
import utility : ungrist ;
import sequence : unique ;

# Refines 'properties' by overriding any elements for which a different
# value is specified in 'requirements'. If the resulting property set
# will be link-incompatible with 'properties', it is an error.
# On success, returns properties. On error, returns a list which first
# element is "@error" and the other elements compose the explanation
# string.
rule refine ( properties * : requirements * : feature-space ? )
{
    feature-space ?= feature ;

    local result ;
    local error ;


    # All the elements of requirements should be present in the result
    # Record them so that we can handle 'properties'.
    for local r in $(requirements)
    {
        # Note: cannot use local here, so take an ugly name
         __require__$(r:G) = $(r:G=) ;
    }

    for local p in $(properties)
    {
        # No processing for free properties
        if free in [ $(feature-space).attributes $(p:G) ]
        {
            result += $(p) ;
        }
        else
        {
            local required-value = $(__require__$(p:G)) ;
            if $(required-value)
            {
                local value = $(p:G=) ;
                if $(value) != $(required-value)
                {
                    if link-incompatible in [ $(feature-space).attributes $(p:G) ]
                    {
                        error = @error link-incompatible properties $(p) and
                                $(p:G)$(required-value) ;
                        # Cannot break, so just iterate again
                    }
                    else
                    {
                        result += $(p:G)$(required-value) ;
                    }
                }
                else
                {
                    result += $(p) ;
                }
            }
            else
            {
                result += $(p) ;
            }
        }
    }

    if $(error)
    {
        return $(error) ;
    }
    else
    {
        return [ unique $(result) $(requirements) ] ;
    }
}

# Helper for as-path, below. Orders properties with the implicit ones
# first, and within the two sections in alphabetical order of feature
# name.
local rule path-order ( feature-space x y )
{
    if $(y:G) && ! $(x:G)
    {
        return true ;
    }
    else if $(x:G) && ! $(y:G)
    {
        return ;
    }
    else
    {
        if ! $(x:G)
        {
            x = [ $(feature-space).expand-subfeatures $(x) ] ;
            y = [ $(feature-space).expand-subfeatures $(y) ] ;
        }
        
        if $(x[0]) < $(y[0])
        {
            return true ;
        }
    }
}

# Returns a path which represents the given expanded property set.
rule as-path ( properties * : feature-space ? )
{
    feature-space ?= feature ;
    
    # trim redundancy
    properties = [ $(feature-space).minimize $(properties) ] ;
    
    # sort according to path-order
    properties = [ sequence.insertion-sort $(properties) : path-order $(feature-space) ] ;
    
    local components ;
    for local p in $(properties)
    {
        if $(p:G)
        {
            local f = [ ungrist $(p:G) ] ;
            components += $(f)-$(p:G=) ;
        }
        else
        {
            components += $(p) ;
        }
    }
    return $(components:J=/) ;
}

local rule __test__ ( )
{
    import class : new ;

    local test-space = [ new feature-space ] ;

    module $(test-space)
    {
        import errors : try catch ;
        import assert ;

        feature toolset : gcc : implicit ;
        feature define : : free ;
        feature runtime-link : dynamic static : symmetric link-incompatible ;
        feature optimization : on off ;
        feature variant : debug release : implicit composite ;
        feature rtti : on off : link-incompatible ;

        compose <variant>debug : <define>_DEBUG <optimization>off ;
        compose <variant>release : <define>NDEBUG <optimization>on ;

    }

    assert.result <toolset>gcc <rtti>off <define>FOO
        : refine <toolset>gcc <rtti>off
        : <define>FOO
        : $(test-space)
        ;

    assert.result <toolset>gcc <optimization>on
        : refine <toolset>gcc <optimization>off
        : <optimization>on
        : $(test-space)
        ;

    assert.result <toolset>gcc <rtti>off
        : refine <toolset>gcc : <rtti>off : $(test-space)
        ;

    assert.result debug
      : as-path <optimization>off <variant>debug
      : $(test-space)
      ;

    assert.result gcc/debug/rtti-off
      : as-path <toolset>gcc <optimization>off <rtti>off <variant>debug
      : $(test-space)
      ;

    r = [ refine <toolset>gcc <rtti>off
            : <rtti>on
            : $(test-space) ] ;
    assert.equal $(r[1]) : "@error" ;

}