From 938f9014c4f0c9f002ba4909e49a5ce648d8f4d7 Mon Sep 17 00:00:00 2001
From: gerd <gerd>
Date: Mon, 19 May 2003 10:40:28 +0000
Subject: [PATCH] 	DEFGENERIC.ERROR.[34] from Paul Dietz' tests.

	* src/pcl/boot.lisp (expand-defgeneric): Add argument precedence
	order option checking.
---
 pcl/boot.lisp | 23 +++++++++++++++++------
 1 file changed, 17 insertions(+), 6 deletions(-)

diff --git a/pcl/boot.lisp b/pcl/boot.lisp
index e514a0849..6d4b5307e 100644
--- a/pcl/boot.lisp
+++ b/pcl/boot.lisp
@@ -25,7 +25,7 @@
 ;;; *************************************************************************
 
 (file-comment
- "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/boot.lisp,v 1.57 2003/05/18 18:09:31 gerd Exp $")
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/boot.lisp,v 1.58 2003/05/19 10:40:28 gerd Exp $")
 
 (in-package :pcl)
 
@@ -234,8 +234,7 @@ work during bootstrapping.
 			format-control format-arguments)
 		function-specifier))
 	     (duplicate-option (name)
-	       (loose "The option ~s appears more than once"
-		      name))
+	       (loose "The option ~s appears more than once" name))
 	     (check-declaration (declaration-specifiers)
 	       (loop for specifier in declaration-specifiers
 		     when (and (consp specifier)
@@ -245,6 +244,17 @@ work during bootstrapping.
 				       :test #'eq)) do
 		     (loose "Declaration specifier ~s is not allowed"
 			    specifier)))
+	     (check-argument-precedence-order (precedence)
+	       (let ((required (parse-lambda-list lambda-list)))
+		 (when (set-difference required precedence)
+		   (loose "Argument precedence order must list all ~
+                           required parameters and only those: ~s"
+			  precedence))
+		 (when (/= (length (remove-duplicates precedence))
+			   (length precedence))
+		   (loose "Duplicate parameter names in argument ~
+                           precedence order: ~s"
+			  precedence))))
 	     (initarg (key &optional (new nil new-supplied-p))
 	       (if new-supplied-p
 		   (setf (getf initargs key) new)
@@ -257,9 +267,10 @@ work during bootstrapping.
       (dolist (option options)
 	(case (car option)
 	  (:argument-precedence-order
-	   (if (initarg :argument-precedence-order)
-	       (duplicate-option :argument-precedence-order)
-	       (initarg :argument-precedence-order `',(cdr option))))
+	   (when (initarg :argument-precedence-order)
+	     (duplicate-option :argument-precedence-order))
+	   (check-argument-precedence-order (cdr option))
+	   (initarg :argument-precedence-order `',(cdr option)))
 	  (declare
 	   (check-declaration (cdr option))
 	   (initarg :declarations
-- 
GitLab