X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/284f1fa2ace3e276052ff1bd7d66442500e693da..caa6f4b99a79f95d15a6cc1e5b8dd27ea48b4d03:/src/class-finalize-impl.lisp

diff --git a/src/class-finalize-impl.lisp b/src/class-finalize-impl.lisp
index 36d56e0..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.