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