diff options
author | Andy Wingo <wingo@pobox.com> | 2017-09-23 14:19:38 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2017-09-23 14:24:34 +0200 |
commit | f23415589a0e263e34a687b5dad1b1624e949639 (patch) | |
tree | 2117cd38e6254d4628d25e1b864861efbe9e748d /module/oop | |
parent | b0ecf83ef0f3dfbfce808c2cfc88ff0c8d9809f1 (diff) | |
download | guile-f23415589a0e263e34a687b5dad1b1624e949639.tar.gz |
GOOPS slot access protected via slot accessors, not struct perms
* module/oop/goops.scm (opaque-slot?, read-only-slot?): New helpers.
(allocate-slots): Protect opaque and read-only slots by wrapping the
slot accessors instead of relying on struct permissions.
(%compute-layout): Remove opaque-slot case.
Diffstat (limited to 'module/oop')
-rw-r--r-- | module/oop/goops.scm | 33 |
1 files changed, 27 insertions, 6 deletions
diff --git a/module/oop/goops.scm b/module/oop/goops.scm index a46918062..4569336a9 100644 --- a/module/oop/goops.scm +++ b/module/oop/goops.scm @@ -719,6 +719,10 @@ followed by its associated value. If @var{l} does not hold a value for (define-standard-accessor-method ((standard-set n) o v) (struct-set! o n v)) +;; Boot definitions. +(define (opaque-slot? slot) #f) +(define (read-only-slot? slot) #f) + (define (allocate-slots class slots) "Transform the computed list of direct slot definitions @var{slots} into a corresponding list of effective slot definitions, allocating @@ -752,11 +756,27 @@ slots as we go." value))) set)))) (lambda (get/raw get set) - (struct-set! slot slot-index-slot-ref/raw get/raw) - (struct-set! slot slot-index-slot-ref get) - (struct-set! slot slot-index-slot-set! set) - (struct-set! slot slot-index-index index) - (struct-set! slot slot-index-size size))) + (let ((get (if (opaque-slot? slot) + (lambda (o) + (error "Slot is opaque" name)) + get)) + (set (cond + ((opaque-slot? slot) + (lambda (o v) + (error "Slot is opaque" name))) + ((read-only-slot? slot) + (lambda (o v) + (let ((v* (get/raw o))) + (if (unbound? v*) + ;; Allow initialization. + (set o v) + (error "Slot is read-only" name))))) + (else set)))) + (struct-set! slot slot-index-slot-ref/raw get/raw) + (struct-set! slot slot-index-slot-ref get) + (struct-set! slot slot-index-slot-set! set) + (struct-set! slot slot-index-index index) + (struct-set! slot slot-index-size size)))) slot)) (struct-set! class class-index-nfields 0) (map-in-order make-effective-slot-definition slots)) @@ -772,7 +792,6 @@ slots as we go." ((subclass? type <protected-slot>) #\p) (else #\u)) (cond - ((subclass? type <opaque-slot>) #\o) ((subclass? type <read-only-slot>) #\r) ((subclass? type <hidden-slot>) #\h) (else #\w))) @@ -893,6 +912,8 @@ slots as we go." (define-standard-class <float-slot> (<foreign-slot>)) (define-standard-class <double-slot> (<foreign-slot>)) +(define (opaque-slot? slot) (is-a? slot <opaque-slot>)) +(define (read-only-slot? slot) (is-a? slot <read-only-slot>)) |