]>
Commit | Line | Data |
---|---|---|
7c673cae FG |
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) | |
7 | ||
8 | # Polymorphic class system built on top of core Jam facilities. | |
9 | # | |
10 | # Classes are defined by 'class' keywords: | |
11 | # | |
12 | # class myclass | |
13 | # { | |
14 | # rule __init__ ( arg1 ) # constructor | |
15 | # { | |
16 | # self.attribute = $(arg1) ; | |
17 | # } | |
18 | # | |
19 | # rule method1 ( ) # method | |
20 | # { | |
21 | # return [ method2 ] ; | |
22 | # } | |
23 | # | |
24 | # rule method2 ( ) # method | |
25 | # { | |
26 | # return $(self.attribute) ; | |
27 | # } | |
28 | # } | |
29 | # | |
30 | # The __init__ rule is the constructor, and sets member variables. | |
31 | # | |
32 | # New instances are created by invoking [ new <class> <args...> ]: | |
33 | # | |
34 | # local x = [ new myclass foo ] ; # x is a new myclass object | |
35 | # assert.result foo : [ $(x).method1 ] ; # $(x).method1 returns "foo" | |
36 | # | |
37 | # Derived class are created by mentioning base classes in the declaration:: | |
38 | # | |
39 | # class derived : myclass | |
40 | # { | |
41 | # rule __init__ ( arg ) | |
42 | # { | |
43 | # myclass.__init__ $(arg) ; # call base __init__ | |
44 | # | |
45 | # } | |
46 | # | |
47 | # rule method2 ( ) # method override | |
48 | # { | |
49 | # return $(self.attribute)XXX ; | |
50 | # } | |
51 | # } | |
52 | # | |
53 | # All methods operate virtually, replacing behavior in the base classes. For | |
54 | # example:: | |
55 | # | |
56 | # local y = [ new derived foo ] ; # y is a new derived object | |
57 | # assert.result fooXXX : [ $(y).method1 ] ; # $(y).method1 returns "foo" | |
58 | # | |
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 | |
92f5a8d4 | 61 | # instance. All rules imported in class declaration, or visible in base classes |
7c673cae FG |
62 | # are also visible. Base methods are available in qualified form: |
63 | # base-name.method-name. By convention, attribute names are prefixed with | |
64 | # "self.". | |
65 | ||
66 | import modules ; | |
67 | import numbers ; | |
68 | ||
69 | ||
70 | rule xinit ( instance : class ) | |
71 | { | |
72 | module $(instance) | |
73 | { | |
74 | __class__ = $(2) ; | |
75 | __name__ = $(1) ; | |
76 | } | |
77 | } | |
78 | ||
79 | ||
80 | rule new ( class args * : * ) | |
81 | { | |
82 | .next-instance ?= 1 ; | |
83 | local id = object($(class))@$(.next-instance) ; | |
84 | ||
85 | INSTANCE $(id) : class@$(class) ; | |
86 | xinit $(id) : $(class) ; | |
87 | IMPORT_MODULE $(id) ; | |
88 | $(id).__init__ $(args) : $(2) : $(3) : $(4) : $(5) : $(6) : $(7) : $(8) : | |
89 | $(9) : $(10) : $(11) : $(12) : $(13) : $(14) : $(15) : $(16) : $(17) : | |
90 | $(18) : $(19) ; | |
91 | ||
92 | # Bump the next unique object name. | |
93 | .next-instance = [ numbers.increment $(.next-instance) ] ; | |
94 | ||
95 | # Return the name of the new instance. | |
96 | return $(id) ; | |
97 | } | |
98 | ||
99 | ||
100 | rule bases ( class ) | |
101 | { | |
102 | module class@$(class) | |
103 | { | |
104 | return $(__bases__) ; | |
105 | } | |
106 | } | |
107 | ||
108 | ||
109 | rule is-derived ( class : bases + ) | |
110 | { | |
111 | local stack = $(class) ; | |
112 | local visited found ; | |
113 | while ! $(found) && $(stack) | |
114 | { | |
115 | local top = $(stack[1]) ; | |
116 | stack = $(stack[2-]) ; | |
117 | if ! ( $(top) in $(visited) ) | |
118 | { | |
119 | visited += $(top) ; | |
120 | stack += [ bases $(top) ] ; | |
121 | ||
122 | if $(bases) in $(visited) | |
123 | { | |
124 | found = true ; | |
125 | } | |
126 | } | |
127 | } | |
128 | return $(found) ; | |
129 | } | |
130 | ||
131 | ||
132 | # Returns true if the 'value' is a class instance. | |
133 | # | |
134 | rule is-instance ( value ) | |
135 | { | |
136 | return [ MATCH "^(object\\()[^@]+\\)@.*" : $(value) ] ; | |
137 | } | |
138 | ||
139 | ||
140 | # Check if the given value is of the given type. | |
141 | # | |
142 | rule is-a ( | |
143 | instance # The value to check. | |
144 | : type # The type to test for. | |
145 | ) | |
146 | { | |
147 | if [ is-instance $(instance) ] | |
148 | { | |
149 | return [ class.is-derived [ modules.peek $(instance) : __class__ ] : $(type) ] ; | |
150 | } | |
151 | } | |
152 | ||
153 | ||
154 | local rule typecheck ( x ) | |
155 | { | |
156 | local class-name = [ MATCH "^\\[(.*)\\]$" : [ BACKTRACE 1 ] ] ; | |
157 | if ! [ is-a $(x) : $(class-name) ] | |
158 | { | |
159 | return "Expected an instance of "$(class-name)" but got \""$(x)"\" for argument" ; | |
160 | } | |
161 | } | |
162 | ||
163 | ||
164 | rule __test__ ( ) | |
165 | { | |
166 | import assert ; | |
167 | import "class" : new ; | |
168 | import errors : try catch ; | |
169 | ||
170 | # This will be the construction function for a class called 'myclass'. | |
171 | # | |
172 | class myclass | |
173 | { | |
174 | import assert ; | |
175 | ||
176 | rule __init__ ( x_ * : y_ * ) | |
177 | { | |
178 | # Set some instance variables. | |
179 | x = $(x_) ; | |
180 | y = $(y_) ; | |
181 | foo += 10 ; | |
182 | } | |
183 | ||
184 | rule set-x ( newx * ) | |
185 | { | |
186 | x = $(newx) ; | |
187 | } | |
188 | ||
189 | rule get-x ( ) | |
190 | { | |
191 | return $(x) ; | |
192 | } | |
193 | ||
194 | rule set-y ( newy * ) | |
195 | { | |
196 | y = $(newy) ; | |
197 | } | |
198 | ||
199 | rule get-y ( ) | |
200 | { | |
201 | return $(y) ; | |
202 | } | |
203 | ||
204 | rule f ( ) | |
205 | { | |
206 | return [ g $(x) ] ; | |
207 | } | |
208 | ||
209 | rule g ( args * ) | |
210 | { | |
211 | if $(x) in $(y) | |
212 | { | |
213 | return $(x) ; | |
214 | } | |
215 | else if $(y) in $(x) | |
216 | { | |
217 | return $(y) ; | |
218 | } | |
219 | else | |
220 | { | |
221 | return ; | |
222 | } | |
223 | } | |
224 | ||
225 | rule get-class ( ) | |
226 | { | |
227 | return $(__class__) ; | |
228 | } | |
229 | ||
230 | rule get-instance ( ) | |
231 | { | |
232 | return $(__name__) ; | |
233 | } | |
234 | ||
235 | rule invariant ( ) | |
236 | { | |
237 | assert.equal 1 : 1 ; | |
238 | } | |
239 | ||
240 | rule get-foo ( ) | |
241 | { | |
242 | return $(foo) ; | |
243 | } | |
244 | } # class myclass ; | |
245 | ||
246 | class derived1 : myclass | |
247 | { | |
248 | rule __init__ ( z_ ) | |
249 | { | |
250 | myclass.__init__ $(z_) : X ; | |
251 | z = $(z_) ; | |
252 | } | |
253 | ||
254 | # Override g. | |
255 | # | |
256 | rule g ( args * ) | |
257 | { | |
258 | return derived1.g ; | |
259 | } | |
260 | ||
261 | rule h ( ) | |
262 | { | |
263 | return derived1.h ; | |
264 | } | |
265 | ||
266 | rule get-z ( ) | |
267 | { | |
268 | return $(z) ; | |
269 | } | |
270 | ||
271 | # Check that 'assert.equal' visible in base class is visible here. | |
272 | # | |
273 | rule invariant2 ( ) | |
274 | { | |
275 | assert.equal 2 : 2 ; | |
276 | } | |
277 | ||
278 | # Check that 'assert.variable-not-empty' visible in base class is | |
279 | # visible here. | |
280 | # | |
281 | rule invariant3 ( ) | |
282 | { | |
283 | local v = 10 ; | |
284 | assert.variable-not-empty v ; | |
285 | } | |
286 | } # class derived1 : myclass ; | |
287 | ||
288 | class derived2 : myclass | |
289 | { | |
290 | rule __init__ ( ) | |
291 | { | |
292 | myclass.__init__ 1 : 2 ; | |
293 | } | |
294 | ||
295 | # Override g. | |
296 | # | |
297 | rule g ( args * ) | |
298 | { | |
299 | return derived2.g ; | |
300 | } | |
301 | ||
302 | # Test the ability to call base class functions with qualification. | |
303 | # | |
304 | rule get-x ( ) | |
305 | { | |
306 | return [ myclass.get-x ] ; | |
307 | } | |
308 | } # class derived2 : myclass ; | |
309 | ||
310 | class derived2a : derived2 | |
311 | { | |
312 | rule __init__ | |
313 | { | |
314 | derived2.__init__ ; | |
315 | } | |
316 | } # class derived2a : derived2 ; | |
317 | ||
318 | local rule expect_derived2 ( [derived2] x ) { } | |
319 | ||
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 ] ; | |
326 | ||
327 | expect_derived2 $(d) ; | |
328 | expect_derived2 $(e) ; | |
329 | ||
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 ] | |
335 | { | |
336 | try ; | |
337 | { | |
338 | expect_derived2 $(a) ; | |
339 | } | |
340 | catch | |
341 | "Expected an instance of derived2 but got" instead | |
342 | ; | |
343 | } | |
344 | ||
345 | #try ; | |
346 | #{ | |
347 | # new bad_subclass ; | |
348 | #} | |
349 | #catch | |
350 | # bad_subclass.bad_subclass failed to call base class constructor | |
351 | # myclass.__init__ | |
352 | # ; | |
353 | ||
354 | #try ; | |
355 | #{ | |
356 | # class bad_subclass ; | |
357 | #} | |
358 | #catch bad_subclass has already been declared ; | |
359 | ||
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 ; | |
371 | ||
372 | assert.result 10 : $(b).get-foo ; | |
373 | ||
374 | $(a).invariant ; | |
375 | $(b).invariant2 ; | |
376 | $(b).invariant3 ; | |
377 | ||
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 ; | |
382 | ||
383 | $(a).set-x a.x ; | |
384 | $(b).set-x b.x ; | |
385 | $(c).set-x c.x ; | |
386 | $(d).set-x d.x ; | |
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 ; | |
391 | ||
392 | class derived3 : derived1 derived2 | |
393 | { | |
394 | rule __init__ ( ) | |
395 | { | |
396 | } | |
397 | } | |
398 | ||
399 | assert.result : bases myclass ; | |
400 | assert.result myclass : bases derived1 ; | |
401 | assert.result myclass : bases derived2 ; | |
402 | assert.result derived1 derived2 : bases derived3 ; | |
403 | ||
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 ; | |
410 | ||
411 | assert.false is-derived myclass : derived1 ; | |
412 | ||
413 | assert.true is-instance $(a) ; | |
414 | assert.false is-instance bar ; | |
415 | ||
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 ; | |
420 | } |