summaryrefslogtreecommitdiff
path: root/module/oop
diff options
context:
space:
mode:
authorDavid Thompson <dthompson@vistahigherlearning.com>2021-01-29 11:04:56 -0500
committerAndy Wingo <wingo@pobox.com>2021-03-19 21:45:53 +0100
commit498564e3e3698565ed5e7697096dd57829d4b686 (patch)
tree8098fd0f7aa0aa7c520339c82a9e3ba83795c666 /module/oop
parentc92f2c7df0532b9f44dea59e68e1079e9504371b (diff)
downloadguile-498564e3e3698565ed5e7697096dd57829d4b686.tar.gz
goops: Preserve all slot options in redefinable classes.
* module/goops.scm (compute-slots): Fix <redefinable-class> slot transformation. * test-suite/tests/goops.test ("slot options on redefinable classes"): Add a test.
Diffstat (limited to 'module/oop')
-rw-r--r--module/oop/goops.scm16
1 files changed, 9 insertions, 7 deletions
diff --git a/module/oop/goops.scm b/module/oop/goops.scm
index 9edc16b07..de5e8907d 100644
--- a/module/oop/goops.scm
+++ b/module/oop/goops.scm
@@ -3081,18 +3081,20 @@ var{initargs}."
(slot-definition-name s)))
(ref (slot-definition-slot-ref/raw s*))
(set! (slot-definition-slot-set! s*)))
- (make (class-of s) #:name (slot-definition-name s)
- #:getter (slot-definition-getter s)
- #:setter (slot-definition-setter s)
- #:accessor (slot-definition-accessor s)
- #:init-keyword (slot-definition-init-keyword s)
- #:init-thunk (slot-definition-init-thunk s)
+ (apply make (class-of s)
#:allocation #:virtual
;; TODO: Make faster.
#:slot-ref (lambda (o)
(ref (slot-ref o 'indirect-slots)))
#:slot-set! (lambda (o v)
- (set! (slot-ref o 'indirect-slots) v)))))
+ (set! (slot-ref o 'indirect-slots) v))
+ (let loop ((options (slot-definition-options s)))
+ (match options
+ (() '())
+ (((or #:allocation #:slot-ref #:slot-set!) _ . rest)
+ (loop rest))
+ ((kw arg . rest)
+ (cons* kw arg (loop rest))))))))
(else s)))
(unless (equal? (list-head slots (length static-slots))
static-slots)