summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2019-12-11 11:42:45 -0800
committerKaz Kylheku <kaz@kylheku.com>2019-12-11 11:42:45 -0800
commitfdba58530a48223ecd0c9bcf629f08c3569d6c75 (patch)
tree573d196ecf232822431800b39af955c1826da342 /tests
parent983a0d26b0d119e0cac73e1a529541c253436d9e (diff)
downloadtxr-fdba58530a48223ecd0c9bcf629f08c3569d6c75.tar.gz
txr-fdba58530a48223ecd0c9bcf629f08c3569d6c75.tar.bz2
txr-fdba58530a48223ecd0c9bcf629f08c3569d6c75.zip
OOP: implementing multiple inheritance.
Multiple inheritance is too useful to ignore any longer. * lib.c (subtypep): Perform subtypep calculation between two struct types via the new struct_subtype_p function. It's too complicated now to do with ad hoc code outside of struct.c. * share/txr/stdlib/struct.tl (defstruct): This macro now needs to deal with the super argument being possibly a list of base types instead of a single one. * strut.c (struct struct_type): Member super and super_handle are removed. New member nsupers, supers, and sus. (struct_init): The super function re-registered; it has an optional argument. (call_stinitfun_chain): The compat code here must now access the supertype differently. We don't bother dealing with multiple inheritance in the compat case; programs requesting compatibility with TXR 151 shoudn't be trying to use multiple inheritance. (get_struct_handles, count_super_stslots, get_super_slots, find_super_for_slot): New static functions, to off-load some new complexity from make_struct_type. (make_struct_type): Handle the increased complexity due to multiple inheritance. (super): Takes an additional argument now, to request which supertype to retrieve. Defaults to zero: the first one. (struct_type_destroy): Free the sus array. (struct_type_mark): Mark the supers slot. (call_initfun_chain): Call init functions of all bases, in right-to-left order. (call_postinitfun_chain): Likewise for postinit functions. (call_super_method, call_super_fun, super_method): Use the first base as the supertype. This requirement feels bad; it needs to be revisited. (do_struct_subtype_p): New static function. (struct_subtype_p): New function. (ancestor_with_static_slot): New static function. (method_name): Revised for multiple inheritance; now relies on ancestor_with_static_slot to find the original ancestor that has brought in a method, so we can use that type in the method name. * struct.h (super): Declaration updated. (struct_subtype_p): Declared. * tests/012/oop-mi.expected: New file. * tests/012/oop-mi.tl: New test cases. * txr.1: Revised in order to document multiple inheritance.
Diffstat (limited to 'tests')
-rw-r--r--tests/012/oop-mi.expected8
-rw-r--r--tests/012/oop-mi.tl47
2 files changed, 55 insertions, 0 deletions
diff --git a/tests/012/oop-mi.expected b/tests/012/oop-mi.expected
new file mode 100644
index 00000000..91bc05df
--- /dev/null
+++ b/tests/012/oop-mi.expected
@@ -0,0 +1,8 @@
+#S(der0 gx gx gy dgy x dx y dy z dz)
+dgs0
+gs1-b1
+#S(der1 x b3x gx b3gx gy gy y b2y)
+gs0
+gs1-b1
+(meth base3 b3m0)
+(meth der1 b3m1)
diff --git a/tests/012/oop-mi.tl b/tests/012/oop-mi.tl
new file mode 100644
index 00000000..162c0243
--- /dev/null
+++ b/tests/012/oop-mi.tl
@@ -0,0 +1,47 @@
+(load "../common")
+
+(defstruct grand nil
+ (gx 'gx)
+ (gy 'gy)
+ (:static gs0 'gs0)
+ (:static gs1 'gs1))
+
+(defstruct base0 nil)
+
+(defstruct base1 grand
+ (x 'b1x)
+ (:static gs1 'gs1-b1))
+
+(defstruct base2 grand
+ (y 'b2y)
+ (:static gs1 'gs1-b2))
+
+(defstruct base3 nil
+ (x 'b3x)
+ (gx 'b3gx)
+ (:method b3m0 (me))
+ (:method b3m1 (me)))
+
+(defstruct der0 (base0 base1 base2 base3)
+ (x 'dx)
+ (y 'dy)
+ (z 'dz)
+ (gy 'dgy)
+ (:static gs0 'dgs0))
+
+(defstruct der1 (base3 base1 base2)
+ (:method b3m1 (me)))
+
+(defvarl d0 (new der0))
+(defvarl d1 (new der1))
+
+(prinl d0)
+(prinl d0.gs0)
+(prinl d0.gs1)
+
+(prinl d1)
+(prinl d1.gs0)
+(prinl d1.gs1)
+
+(prinl (func-get-name d0.b3m0))
+(prinl (func-get-name d1.b3m1))