From 25a00dc051fb2486c0b5c69e2d40f712c2f880cd Mon Sep 17 00:00:00 2001
From: pmai <pmai>
Date: Sat, 19 Oct 2002 15:18:47 +0000
Subject: [PATCH] Committed patch by Gerd Moellmann to check generic function
 declarations against the set of forbidden declarations specified by the ANSI
 entry on defgeneric.

---
 pcl/boot.lisp | 32 +++++++++++++++++++-------------
 1 file changed, 19 insertions(+), 13 deletions(-)

diff --git a/pcl/boot.lisp b/pcl/boot.lisp
index 881af0e59..5cf731471 100644
--- a/pcl/boot.lisp
+++ b/pcl/boot.lisp
@@ -26,7 +26,7 @@
 ;;;
 
 (ext:file-comment
- "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/boot.lisp,v 1.39 2002/10/19 14:56:01 pmai Exp $")
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/boot.lisp,v 1.40 2002/10/19 15:18:47 pmai Exp $")
 
 (in-package :pcl)
 
@@ -229,18 +229,23 @@ work during bootstrapping.
 (defun expand-defgeneric (function-specifier lambda-list options)
   (let ((initargs ())
 	(methods ()))
-    (flet ((duplicate-option (name)
-	     (simple-program-error "The option ~S appears more than once."
-				   name)))
-      ;;
-      ;; INITARG takes this screwy new argument to get around a bad
-      ;; interaction between lexical macros and setf in the Lucid
-      ;; compiler.
-      ;; 
-      (macrolet ((initarg (key &optional new)
-		   (if new
-		       `(setf (getf initargs ,key) ,new)
-		       `(getf initargs ,key))))
+    (labels ((duplicate-option (name)
+	       (simple-program-error "The option ~S appears more than once."
+				     name))
+	     (check-declaration (declaration-specifiers)
+	       (loop for specifier in declaration-specifiers
+		     when (and (consp specifier)
+			       (member (car specifier)
+				       '(special ftype function inline
+					 notinline declaration)
+				       :test #'eq)) do
+		       (simple-program-error
+			"Declaration specifier ~S is not allowed"
+			specifier)))
+	     (initarg (key &optional (new nil new-supplied-p))
+	       (if new-supplied-p
+		   (setf (getf initargs key) new)
+		   (getf initargs key))))
 	(dolist (option options)
 	  (case (car option)
 	    (:argument-precedence-order
@@ -248,6 +253,7 @@ work during bootstrapping.
 		  (duplicate-option :argument-precedence-order)
 		  (initarg :argument-precedence-order `',(cdr option))))
 	    (declare
+	      (check-declaration (cdr option))
 	      (initarg :declarations
 		       (append (cdr option) (initarg :declarations))))
 	    (:documentation
-- 
GitLab