X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/981b6fb624186a54320cea34e53e16276aee2bdb..02840f3dba856d042fe27a0adfb0367346447cda:/src/class-finalize-impl.lisp

diff --git a/src/class-finalize-impl.lisp b/src/class-finalize-impl.lisp
index 23d7107..be42f13 100644
--- a/src/class-finalize-impl.lisp
+++ b/src/class-finalize-impl.lisp
@@ -343,6 +343,41 @@
 	(error "In `~A~, chain-to class `~A' is not a proper superclass"
 	       class chain-link)))
 
+    ;; Check that the initargs declare compatible types.  Duplicate entries,
+    ;; even within a class, are harmless, but at most one initarg in any
+    ;; class should declare a default value.
+    (with-slots (class-precedence-list) class
+      (let ((seen (make-hash-table :test #'equal)))
+	(dolist (super class-precedence-list)
+	  (with-slots (initargs) super
+	    (dolist (initarg (reverse initargs))
+	      (let* ((initarg-name (sod-initarg-name initarg))
+		     (initarg-type (sod-initarg-type initarg))
+		     (initarg-default (sod-initarg-default initarg))
+		     (found (gethash initarg-name seen))
+		     (found-type (and found (sod-initarg-type found)))
+		     (found-default (and found (sod-initarg-default found)))
+		     (found-class (and found (sod-initarg-class found)))
+		     (found-location (and found (file-location found))))
+		(with-default-error-location (initarg)
+		  (cond ((not found)
+			 (setf (gethash initarg-name seen) initarg))
+			((not (c-type-equal-p initarg-type found-type))
+			 (cerror* "Inititalization argument `~A' defined ~
+				   with incompatible types: ~
+				   ~A in class ~A, and ~
+				   ~A in class ~A (at ~A)"
+				initarg-name initarg-type super
+				found-type found-class found-location))
+			((and initarg-default found-default
+			      (eql super found-class))
+			 (cerror* "Initialization argument `~A' redefined ~
+				   with default value ~
+				   (previous definition at ~A)"
+				  initarg-name found-location))
+			(initarg-default
+			 (setf (gethash initarg-name seen) initarg))))))))))
+
     ;; Check for circularity in the superclass graph.  Since the superclasses
     ;; should already be acyclic, it suffices to check that our class is not
     ;; a superclass of any of its own direct superclasses.
@@ -431,13 +466,13 @@
       (:finalized
        t))))
 
-(macrolet ((define-layout-slot (slot (class) &body body)
-	     `(define-on-demand-slot sod-class ,slot (,class)
-		(check-class-is-finalized ,class)
-		,@body)))
-  (flet ((check-class-is-finalized (class)
-	   (unless (eq (sod-class-state class) :finalized)
-	     (error "Class ~S is not finalized" class))))
+(flet ((check-class-is-finalized (class)
+	 (unless (eq (sod-class-state class) :finalized)
+	   (error "Class ~S is not finalized" class))))
+  (macrolet ((define-layout-slot (slot (class) &body body)
+	       `(define-on-demand-slot sod-class ,slot (,class)
+		  (check-class-is-finalized ,class)
+		  ,@body)))
     (define-layout-slot %ilayout (class)
       (compute-ilayout class))
     (define-layout-slot effective-methods (class)