summaryrefslogtreecommitdiff
path: root/oop/goops.scm
diff options
context:
space:
mode:
authorMikael Djurfeldt <djurfeldt@nada.kth.se>2003-04-17 17:37:11 +0000
committerMikael Djurfeldt <djurfeldt@nada.kth.se>2003-04-17 17:37:11 +0000
commit266f3a23d7d905b044bf9b69ec2f7aaf41abf0d0 (patch)
treeb1bcd5fb97e5fc7274370f7a7fd581fca10568b3 /oop/goops.scm
parent57b1d5184114565df5a1094277ecd717d77115a0 (diff)
downloadguile-266f3a23d7d905b044bf9b69ec2f7aaf41abf0d0.tar.gz
* goops.scm (compute-getters-n-setters): Check for bad init-thunk.
Diffstat (limited to 'oop/goops.scm')
-rw-r--r--oop/goops.scm12
1 files changed, 9 insertions, 3 deletions
diff --git a/oop/goops.scm b/oop/goops.scm
index 70d47b4f8..08ce58c52 100644
--- a/oop/goops.scm
+++ b/oop/goops.scm
@@ -1192,8 +1192,14 @@
;;;
(define (compute-getters-n-setters class slots env)
- (define (compute-slot-init-function s)
- (or (slot-definition-init-thunk s)
+ (define (compute-slot-init-function name s)
+ (or (let ((thunk (slot-definition-init-thunk s)))
+ (and thunk
+ (if (not (and (closure? thunk)
+ (thunk? thunk)))
+ (goops-error "Bad init-thunk for slot `~S' in ~S: ~S"
+ name class thunk))
+ thunk))
(let ((init (slot-definition-init-value s)))
(and (not (unbound? init))
(lambda () init)))))
@@ -1233,7 +1239,7 @@
;; '() for other slots
(verify-accessors name g-n-s)
(cons name
- (cons (compute-slot-init-function s)
+ (cons (compute-slot-init-function name s)
(if (or (integer? g-n-s)
(zero? size))
g-n-s