diff options
author | Mikael Djurfeldt <djurfeldt@nada.kth.se> | 2003-04-17 17:37:11 +0000 |
---|---|---|
committer | Mikael Djurfeldt <djurfeldt@nada.kth.se> | 2003-04-17 17:37:11 +0000 |
commit | 266f3a23d7d905b044bf9b69ec2f7aaf41abf0d0 (patch) | |
tree | b1bcd5fb97e5fc7274370f7a7fd581fca10568b3 /oop/goops.scm | |
parent | 57b1d5184114565df5a1094277ecd717d77115a0 (diff) | |
download | guile-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.scm | 12 |
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 |