diff options
author | David Thompson <dthompson@vistahigherlearning.com> | 2021-01-29 11:04:56 -0500 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2021-03-19 21:45:53 +0100 |
commit | 498564e3e3698565ed5e7697096dd57829d4b686 (patch) | |
tree | 8098fd0f7aa0aa7c520339c82a9e3ba83795c666 /module/oop | |
parent | c92f2c7df0532b9f44dea59e68e1079e9504371b (diff) | |
download | guile-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.scm | 16 |
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) |