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