1 # Copyright 2001, 2002, 2003 Dave Abrahams
2 # Copyright 2002, 2005 Rene Rivera
3 # Copyright 2002, 2003 Vladimir Prus
4 # Distributed under the Boost Software License, Version 1.0.
5 # (See accompanying file LICENSE_1_0.txt or copy at
6 # http://www.boost.org/LICENSE_1_0.txt)
8 # Polymorphic class system built on top of core Jam facilities.
10 # Classes are defined by 'class' keywords:
14 # rule __init__ ( arg1 ) # constructor
16 # self.attribute = $(arg1) ;
19 # rule method1 ( ) # method
21 # return [ method2 ] ;
24 # rule method2 ( ) # method
26 # return $(self.attribute) ;
30 # The __init__ rule is the constructor, and sets member variables.
32 # New instances are created by invoking [ new <class> <args...> ]:
34 # local x = [ new myclass foo ] ; # x is a new myclass object
35 # assert.result foo : [ $(x).method1 ] ; # $(x).method1 returns "foo"
37 # Derived class are created by mentioning base classes in the declaration::
39 # class derived : myclass
41 # rule __init__ ( arg )
43 # myclass.__init__ $(arg) ; # call base __init__
47 # rule method2 ( ) # method override
49 # return $(self.attribute)XXX ;
53 # All methods operate virtually, replacing behavior in the base classes. For
56 # local y = [ new derived foo ] ; # y is a new derived object
57 # assert.result fooXXX : [ $(y).method1 ] ; # $(y).method1 returns "foo"
59 # Each class instance is its own core Jam module. All instance attributes and
60 # methods are accessible without additional qualification from within the class
61 # instance. All rules imported in class declaration, or visible in base classes
62 # are also visible. Base methods are available in qualified form:
63 # base-name.method-name. By convention, attribute names are prefixed with
70 rule xinit ( instance : class )
80 rule new ( class args * : * )
83 local id = object($(class))@$(.next-instance) ;
85 INSTANCE $(id) : class@$(class) ;
86 xinit $(id) : $(class) ;
88 $(id).__init__ $(args) : $(2) : $(3) : $(4) : $(5) : $(6) : $(7) : $(8) :
89 $(9) : $(10) : $(11) : $(12) : $(13) : $(14) : $(15) : $(16) : $(17) :
92 # Bump the next unique object name.
93 .next-instance = [ numbers.increment $(.next-instance) ] ;
95 # Return the name of the new instance.
102 module class@$(class)
104 return $(__bases__) ;
109 rule is-derived ( class : bases + )
111 local stack = $(class) ;
112 local visited found ;
113 while ! $(found) && $(stack)
115 local top = $(stack[1]) ;
116 stack = $(stack[2-]) ;
117 if ! ( $(top) in $(visited) )
120 stack += [ bases $(top) ] ;
122 if $(bases) in $(visited)
132 # Returns true if the 'value' is a class instance.
134 rule is-instance ( value )
136 return [ MATCH "^(object\\()[^@]+\\)@.*" : $(value) ] ;
140 # Check if the given value is of the given type.
143 instance # The value to check.
144 : type # The type to test for.
147 if [ is-instance $(instance) ]
149 return [ class.is-derived [ modules.peek $(instance) : __class__ ] : $(type) ] ;
154 local rule typecheck ( x )
156 local class-name = [ MATCH "^\\[(.*)\\]$" : [ BACKTRACE 1 ] ] ;
157 if ! [ is-a $(x) : $(class-name) ]
159 return "Expected an instance of "$(class-name)" but got \""$(x)"\" for argument" ;
167 import "class" : new ;
168 import errors : try catch ;
170 # This will be the construction function for a class called 'myclass'.
176 rule __init__ ( x_ * : y_ * )
178 # Set some instance variables.
184 rule set-x ( newx * )
194 rule set-y ( newy * )
227 return $(__class__) ;
230 rule get-instance ( )
246 class derived1 : myclass
250 myclass.__init__ $(z_) : X ;
271 # Check that 'assert.equal' visible in base class is visible here.
278 # Check that 'assert.variable-not-empty' visible in base class is
284 assert.variable-not-empty v ;
286 } # class derived1 : myclass ;
288 class derived2 : myclass
292 myclass.__init__ 1 : 2 ;
302 # Test the ability to call base class functions with qualification.
306 return [ myclass.get-x ] ;
308 } # class derived2 : myclass ;
310 class derived2a : derived2
316 } # class derived2a : derived2 ;
318 local rule expect_derived2 ( [derived2] x ) { }
320 local a = [ new myclass 3 4 5 : 4 5 ] ;
321 local b = [ new derived1 4 ] ;
322 local b2 = [ new derived1 4 ] ;
323 local c = [ new derived2 ] ;
324 local d = [ new derived2 ] ;
325 local e = [ new derived2a ] ;
327 expect_derived2 $(d) ;
328 expect_derived2 $(e) ;
330 # Argument checking is set up to call exit(1) directly on failure, and we
331 # can not hijack that with try, so we should better not do this test by
332 # default. We could fix this by having errors look up and invoke the EXIT
333 # rule instead; EXIT can be hijacked (;-)
334 if --fail-typecheck in [ modules.peek : ARGV ]
338 expect_derived2 $(a) ;
341 "Expected an instance of derived2 but got" instead
350 # bad_subclass.bad_subclass failed to call base class constructor
356 # class bad_subclass ;
358 #catch bad_subclass has already been declared ;
360 assert.result 3 4 5 : $(a).get-x ;
361 assert.result 4 5 : $(a).get-y ;
362 assert.result 4 : $(b).get-x ;
363 assert.result X : $(b).get-y ;
364 assert.result 4 : $(b).get-z ;
365 assert.result 1 : $(c).get-x ;
366 assert.result 2 : $(c).get-y ;
367 assert.result 4 5 : $(a).f ;
368 assert.result derived1.g : $(b).f ;
369 assert.result derived2.g : $(c).f ;
370 assert.result derived2.g : $(d).f ;
372 assert.result 10 : $(b).get-foo ;
378 # Check that the __class__ attribute is getting properly set.
379 assert.result myclass : $(a).get-class ;
380 assert.result derived1 : $(b).get-class ;
381 assert.result $(a) : $(a).get-instance ;
387 assert.result a.x : $(a).get-x ;
388 assert.result b.x : $(b).get-x ;
389 assert.result c.x : $(c).get-x ;
390 assert.result d.x : $(d).get-x ;
392 class derived3 : derived1 derived2
399 assert.result : bases myclass ;
400 assert.result myclass : bases derived1 ;
401 assert.result myclass : bases derived2 ;
402 assert.result derived1 derived2 : bases derived3 ;
404 assert.true is-derived derived1 : myclass ;
405 assert.true is-derived derived2 : myclass ;
406 assert.true is-derived derived3 : derived1 ;
407 assert.true is-derived derived3 : derived2 ;
408 assert.true is-derived derived3 : derived1 derived2 myclass ;
409 assert.true is-derived derived3 : myclass ;
411 assert.false is-derived myclass : derived1 ;
413 assert.true is-instance $(a) ;
414 assert.false is-instance bar ;
416 assert.true is-a $(a) : myclass ;
417 assert.true is-a $(c) : derived2 ;
418 assert.true is-a $(d) : myclass ;
419 assert.false is-a literal : myclass ;