diff options
author | Andy Wingo <wingo@pobox.com> | 2017-09-23 15:15:18 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2017-09-23 15:15:18 +0200 |
commit | 0f14a9e59826c1c304d1f50c741e91d99760ff43 (patch) | |
tree | e520901d32bf8fdb95cf4d339a981b29dafa9b7a /module/oop | |
parent | b7d88bfe6328413a4a8a09e7826f7e560f830d40 (diff) | |
download | guile-0f14a9e59826c1c304d1f50c741e91d99760ff43.tar.gz |
Fix bootstrap slot permissions for <class>
* module/oop/goops.scm: Fix bootstrap slot computation to preserve slot
permissions.
Diffstat (limited to 'module/oop')
-rw-r--r-- | module/oop/goops.scm | 16 |
1 files changed, 13 insertions, 3 deletions
diff --git a/module/oop/goops.scm b/module/oop/goops.scm index 78bbc4bf1..39bff0667 100644 --- a/module/oop/goops.scm +++ b/module/oop/goops.scm @@ -932,13 +932,23 @@ slots as we go." ;; Boot definition that avoids munging nfields. (define (allocate-slots class slots) (define (make-effective-slot-definition slot index) - (let* ((slot (compute-effective-slot-definition class slot))) + (let* ((slot (compute-effective-slot-definition class slot)) + (get/raw (standard-get index)) + (set/raw (standard-set index))) (struct-set! slot slot-index-slot-ref/raw (standard-get index)) (struct-set! slot slot-index-slot-ref (if (slot-definition-init-thunk slot) - (struct-ref slot slot-index-slot-ref/raw) + get/raw (bound-check-get index))) - (struct-set! slot slot-index-slot-set! (standard-set index)) + (struct-set! slot slot-index-slot-set! + (if (read-only-slot? slot) + (lambda (o v) + (let ((v* (get/raw o))) + (if (unbound? v*) + ;; Allow initialization. + (set/raw o v) + (error "Slot is read-only" slot)))) + set/raw)) (struct-set! slot slot-index-index index) (struct-set! slot slot-index-size 1) slot)) |