| # Copyright 2001, 2002 Dave Abrahams |
| # Copyright 2002, 2003, 2004, 2005 Vladimir Prus |
| # Copyright 2008 Jurko Gospodnetic |
| # Distributed under the Boost Software License, Version 1.0. |
| # (See accompanying file LICENSE_1_0.txt or http://www.boost.org/LICENSE_1_0.txt) |
| |
| import "class" : is-instance ; |
| import errors ; |
| |
| |
| # For all elements of 'list' which do not already have 'suffix', add 'suffix'. |
| # |
| rule apply-default-suffix ( suffix : list * ) |
| { |
| local result ; |
| for local i in $(list) |
| { |
| if $(i:S) = $(suffix) |
| { |
| result += $(i) ; |
| } |
| else |
| { |
| result += $(i)$(suffix) ; |
| } |
| } |
| return $(result) ; |
| } |
| |
| |
| # If 'name' contains a dot, returns the part before the last dot. If 'name' |
| # contains no dot, returns it unmodified. |
| # |
| rule basename ( name ) |
| { |
| if $(name:S) |
| { |
| name = $(name:B) ; |
| } |
| return $(name) ; |
| } |
| |
| |
| # Return the file of the caller of the rule that called caller-file. |
| # |
| rule caller-file ( ) |
| { |
| local bt = [ BACKTRACE ] ; |
| return $(bt[9]) ; |
| } |
| |
| |
| # Tests if 'a' is equal to 'b'. If 'a' is a class instance, calls its 'equal' |
| # method. Uses ordinary jam's comparison otherwise. |
| # |
| rule equal ( a b ) |
| { |
| if [ is-instance $(a) ] |
| { |
| return [ $(a).equal $(b) ] ; |
| } |
| else |
| { |
| if $(a) = $(b) |
| { |
| return true ; |
| } |
| } |
| } |
| |
| |
| # Tests if 'a' is less than 'b'. If 'a' is a class instance, calls its 'less' |
| # method. Uses ordinary jam's comparison otherwise. |
| # |
| rule less ( a b ) |
| { |
| if [ is-instance $(a) ] |
| { |
| return [ $(a).less $(b) ] ; |
| } |
| else |
| { |
| if $(a) < $(b) |
| { |
| return true ; |
| } |
| } |
| } |
| |
| |
| # Returns the textual representation of argument. If it is a class instance, |
| # class its 'str' method. Otherwise, returns the argument. |
| # |
| rule str ( value ) |
| { |
| if [ is-instance $(value) ] |
| { |
| return [ $(value).str ] ; |
| } |
| else |
| { |
| return $(value) ; |
| } |
| } |
| |
| |
| # Accepts a list of gristed values and returns them ungristed. Reports an error |
| # in case any of the passed parameters is not gristed, i.e. surrounded in angle |
| # brackets < and >. |
| # |
| rule ungrist ( names * ) |
| { |
| local result ; |
| for local name in $(names) |
| { |
| local stripped = [ MATCH ^<(.*)>$ : $(name) ] ; |
| if ! $(stripped) |
| { |
| errors.error "in ungrist $(names) : $(name) is not of the form <.*>" ; |
| } |
| result += $(stripped) ; |
| } |
| return $(result) ; |
| } |
| |
| |
| # If the passed value is quoted, unquotes it. Otherwise returns the value |
| # unchanged. |
| # |
| rule unquote ( value ? ) |
| { |
| local match-result = [ MATCH ^(\")(.*)(\")$ : $(value) ] ; |
| if $(match-result) |
| { |
| return $(match-result[2]) ; |
| } |
| else |
| { |
| return $(value) ; |
| } |
| } |
| |
| |
| rule __test__ ( ) |
| { |
| import assert ; |
| import "class" : new ; |
| import errors : try catch ; |
| |
| assert.result 123 : str 123 ; |
| |
| class test-class__ |
| { |
| rule __init__ ( ) { } |
| rule str ( ) { return "str-test-class" ; } |
| rule less ( a ) { return "yes, of course!" ; } |
| rule equal ( a ) { return "not sure" ; } |
| } |
| |
| assert.result "str-test-class" : str [ new test-class__ ] ; |
| assert.true less 1 2 ; |
| assert.false less 2 1 ; |
| assert.result "yes, of course!" : less [ new test-class__ ] 1 ; |
| assert.true equal 1 1 ; |
| assert.false equal 1 2 ; |
| assert.result "not sure" : equal [ new test-class__ ] 1 ; |
| |
| assert.result foo.lib foo.lib : apply-default-suffix .lib : foo.lib foo.lib |
| ; |
| |
| assert.result foo : basename foo ; |
| assert.result foo : basename foo.so ; |
| assert.result foo.so : basename foo.so.1 ; |
| |
| assert.result : unquote ; |
| assert.result "" : unquote "" ; |
| assert.result foo : unquote foo ; |
| assert.result \"foo : unquote \"foo ; |
| assert.result foo\" : unquote foo\" ; |
| assert.result foo : unquote \"foo\" ; |
| assert.result \"foo\" : unquote \"\"foo\"\" ; |
| |
| assert.result : ungrist ; |
| assert.result foo : ungrist <foo> ; |
| assert.result <foo> : ungrist <<foo>> ; |
| assert.result foo bar : ungrist <foo> <bar> ; |
| |
| try ; |
| { |
| ungrist "" ; |
| } |
| catch "in ungrist : is not of the form <.*>" ; |
| |
| try ; |
| { |
| ungrist <> ; |
| } |
| catch "in ungrist <> : <> is not of the form <.*>" ; |
| |
| try ; |
| { |
| ungrist foo ; |
| } |
| catch "in ungrist foo : foo is not of the form <.*>" ; |
| |
| try ; |
| { |
| ungrist <foo ; |
| } |
| catch "in ungrist <foo : <foo is not of the form <.*>" ; |
| |
| try ; |
| { |
| ungrist foo> ; |
| } |
| catch "in ungrist foo> : foo> is not of the form <.*>" ; |
| |
| try ; |
| { |
| ungrist foo bar ; |
| } |
| catch "in ungrist foo : foo is not of the form <.*>" ; |
| |
| try ; |
| { |
| ungrist foo <bar> ; |
| } |
| catch "in ungrist foo : foo is not of the form <.*>" ; |
| |
| try ; |
| { |
| ungrist <foo> bar ; |
| } |
| catch "in ungrist bar : bar is not of the form <.*>" ; |
| } |