diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2024-07-19 17:22:22 -0700 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2024-07-19 17:22:22 -0700 |
| commit | 1676d6a255354329bde19f9ab141ce672112a358 (patch) | |
| tree | 19707f312ed035cbd46440469977ad6a15d9a093 /tests | |
| parent | 8f026a4fc707243151faffb89586460354d41cd2 (diff) | |
| download | txr-1676d6a255354329bde19f9ab141ce672112a358.tar.gz txr-1676d6a255354329bde19f9ab141ce672112a358.tar.bz2 txr-1676d6a255354329bde19f9ab141ce672112a358.zip | |
oop: special methods to handle missing slots.
* struct.h (slotset_s, static_slot_s, static_slot_set_s): New
symbol variables declared.
(enum special_slot): New enum symbols: slot_m, slotset_m,
static_slot_m, static_slot_set_m.
* struct.c (slotset_s, static_slot_s, static_slot_set_s): New
symbol variables.
(special_sym): Associate new symbols with new enums.
(struct_init): Intern slotset, static-slot and static-slot-set
symbols, initializing the variables. Change the registrations
of the same-named functions to use the variables.
(slot, maybe_slot, slotset, static_slot, static_slot_set):
In the no-such-slot case, check for the special method and
call it.
* tests/012/oop.tl: New tests.
* txr.1: Documented.
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/012/oop.tl | 36 |
1 files changed, 36 insertions, 0 deletions
diff --git a/tests/012/oop.tl b/tests/012/oop.tl index 8bf8b4b4..7633b645 100644 --- a/tests/012/oop.tl +++ b/tests/012/oop.tl @@ -159,3 +159,39 @@ (new node left (succ me.left) right (succ me.right))) (test (copy (new node left 1 right 2)) #S(node left 2 right 3)) + +(defstruct cust-slots () + a + (:method slot (me slot) ^(slot ,slot)) + (:method slotset (me slot new) ^(slotset ,slot ,new)) + (:function static-slot (type slot) ^(static-slot ,slot)) + (:function static-slot-set (type slot new) ^(static-slot-set ,slot ,new))) + +(defstruct no-cust-slots () + a) + +(defstruct get-type () + (:function static-slot (type slot) type) + (:function static-slot-set (type slot new) type)) + +(let ((o (new cust-slots))) + (mtest + o.a nil + o.b (slot b) + (set o.b 3) (slotset b 3) + (static-slot 'cust-slots 'b) (static-slot b) + (static-slot-set 'cust-slots 'b 3) (static-slot-set b 3))) + +(let ((o (new no-cust-slots))) + (mtest + o.a nil + o.b :error + (set o.b 3) :error + (static-slot 'no-cust-slots 'b) :error + (static-slot-set 'no-cust-slots 'b 3) :error)) + +(mvtest + (static-slot 'get-type 'b) (find-struct-type 'get-type) + (static-slot (find-struct-type 'get-type) 'b) (find-struct-type 'get-type) + (static-slot-set 'get-type 'b 3) (find-struct-type 'get-type) + (static-slot-set (find-struct-type 'get-type) 'b 3) (find-struct-type 'get-type)) |