* goops.scm (compute-getters-n-setters): Allow for primitive

procedure thunks.  (Thanks to Neil W. Van Dyke.)

NEWS

@@ -56,6 +56,13 @@ got confused if handed method code created in a null environment
 (environment = empty list).  It now stands every environment
 imaginable (think about it!).
 
+** GOOPS init-thunks can now be primitive procedures
+
+Previously, attempts to provide something else than a closure as value
+for the #:init-thunk slot option would yield a segmentation fault.
+Now, it's possible to supply a primitive procedure as init-thunk.
+Non-allowed values result in an error.
+
 ** Garbage collection frequency improved for large malloc heaps
 
 The decision when to run the GC is now done in a way that avoids GCs

oop/ChangeLog

@@ -1,3 +1,8 @@
+2003-04-20  Mikael Djurfeldt  <djurfeldt@nada.kth.se>
+
+	* goops.scm (compute-getters-n-setters): Allow for primitive
+	procedure thunks.  (Thanks to Neil W. Van Dyke.)
+
 2003-04-19  Mikael Djurfeldt  <djurfeldt@nada.kth.se>
 
 	* goops/dispatch.scm (cache-hashval): Corrected termination

oop/goops.scm

@@ -508,7 +508,7 @@
 (define method
   (letrec ((specializers
 	    (lambda (ls)
-	      (cond ((null? ls) '('()))
+	      (cond ((null? ls) (list (list 'quote '())))
 		    ((pair? ls) (cons (if (pair? (car ls))
 					  (cadar ls)
 					  '<top>)
@@ -1043,16 +1043,19 @@
 
 ;;; compute-getters-n-setters
 ;;;
+(define (make-thunk thunk)
+  (lambda () (thunk)))
+
 (define (compute-getters-n-setters class slots env)
 
   (define (compute-slot-init-function name s)
     (or (let ((thunk (slot-definition-init-thunk s)))
 	  (and thunk
-	       (if (not (and (closure? thunk)
-			     (thunk? thunk)))
+	       (cond ((not (thunk? thunk))
 		      (goops-error "Bad init-thunk for slot `~S' in ~S: ~S"
 				   name class thunk))
-	       thunk))
+		     ((closure? thunk) thunk)
+		     (else (make-thunk thunk)))))
 	(let ((init (slot-definition-init-value s)))
 	  (and (not (unbound? init))
 	       (lambda () init)))))