mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-09 13:30:26 +02:00
Fix class slot allocation since GOOPS rewrite
* module/oop/goops.scm (%compute-layout): Fix class slot layout. Before, a #:class that was an argument to #:allocation was getting interpreted as a keyword with a value. * test-suite/tests/goops.test ("#:class slot allocation"): Add test.
This commit is contained in:
parent
a86bb2e613
commit
77cfd7e4bf
2 changed files with 10 additions and 1 deletions
|
@ -765,7 +765,7 @@ slots as we go."
|
|||
(define (slot-protection-and-kind slot)
|
||||
(define (subclass? class parent)
|
||||
(memq parent (class-precedence-list class)))
|
||||
(let ((type (kw-arg-ref (%slot-definition-options slot) #:class)))
|
||||
(let ((type (get-keyword #:class (%slot-definition-options slot))))
|
||||
(if (and type (subclass? type <foreign-slot>))
|
||||
(values (cond
|
||||
((subclass? type <self-slot>) #\s)
|
||||
|
|
|
@ -572,6 +572,15 @@
|
|||
exception:out-of-range
|
||||
(make <foreign-test> #:a (ash 1 64))))
|
||||
|
||||
(with-test-prefix "#:class slot allocation"
|
||||
(pass-if-equal "basic class slot allocation" #:class
|
||||
(eval '(begin
|
||||
(define-class <has-a-class-slot> ()
|
||||
(bar #:allocation #:class #:init-value 'baz))
|
||||
(slot-definition-allocation
|
||||
(class-slot-definition <has-a-class-slot> 'bar)))
|
||||
(current-module))))
|
||||
|
||||
(with-test-prefix "#:each-subclass"
|
||||
(let* ((<subclass-allocation-test>
|
||||
(class ()
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue