From f1455e425248c66514e393d500b2e55d66dc3c5b Mon Sep 17 00:00:00 2001
From: gerd <gerd>
Date: Sun, 18 May 2003 12:23:21 +0000
Subject: [PATCH] 	Methods with &optional args could be called with too
 many 	arguments without signaling an error.  Found by Paul Dietz' 	test
 suite, MAKE-LOAD-FORM.ERROR.2.

	* src/pcl/boot.lisp (too-many-args): New function.
	(bind-args): Use it.
---
 general-info/release-19a.txt |  1 +
 pcl/boot.lisp                | 10 ++++++++--
 2 files changed, 9 insertions(+), 2 deletions(-)

diff --git a/general-info/release-19a.txt b/general-info/release-19a.txt
index 9ae69c38d..500925dda 100644
--- a/general-info/release-19a.txt
+++ b/general-info/release-19a.txt
@@ -112,6 +112,7 @@ New in this release:
      - ALLOCATE-INSTANCE working with structures defined with DEFSTRUCT.
      - With (DEFGENERIC FOO (&REST X &KEY)) (DEFMETHOD FOO (&REST X) X),
        (FOO 1) now signals an error.
+     - Methods with &OPTIONAL arguments detecting too many args.
 
   * Improvements to Hemlock, the Emacs-like editor:
 
diff --git a/pcl/boot.lisp b/pcl/boot.lisp
index b544af355..f1135c8a2 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.55 2003/05/09 17:09:52 gerd Exp $")
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/boot.lisp,v 1.56 2003/05/18 12:23:21 gerd Exp $")
 
 (in-package :pcl)
 
@@ -1009,12 +1009,18 @@ work during bootstrapping.
       (let ((bindings (mapcan #'process-var lambda-list)))
 	`(let* ((,args-tail ,args)
 		,@bindings
+		(.dummy1. ,@(when (eq state 'optional)
+			      `((unless (null ,args-tail)
+				  (too-many-args)))))
 		(.dummy. ,@(when (and key-seen (zerop nkeys))
 			     `((get-key-arg1 :allow-other-keys
 					     ,args-tail t)))))
-	   (declare (ignorable ,args-tail .dummy.))
+	   (declare (ignorable ,args-tail .dummy. .dummy1.))
 	   ,@body)))))
 
+(defun too-many-args ()
+  (simple-program-error "Too many arguments."))
+
 (defun odd-number-of-keyword-arguments ()
   (simple-program-error "Odd number of keyword arguments."))
 
-- 
GitLab