From 10faeaa6d120a04fab4f261df83d3a4c79e332a8 Mon Sep 17 00:00:00 2001 From: gerd <gerd> Date: Wed, 3 Sep 2003 10:17:22 +0000 Subject: [PATCH] * src/pcl/ctor.lisp (call-ctor): Consider only ctors whose initargs are the same, including order and length, as the original make-instance args, for preserving arguments order in functions called from the ctor, e.g. initialize-instance. Reported by Craig Lanning. --- pcl/ctor.lisp | 27 ++++++++++++++------------- 1 file changed, 14 insertions(+), 13 deletions(-) diff --git a/pcl/ctor.lisp b/pcl/ctor.lisp index 3e10e9c52..830cfc646 100644 --- a/pcl/ctor.lisp +++ b/pcl/ctor.lisp @@ -46,7 +46,7 @@ ;;; is called. (file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/ctor.lisp,v 1.15 2003/07/01 16:32:41 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/ctor.lisp,v 1.16 2003/09/03 10:17:22 gerd Exp $") (in-package "PCL") @@ -762,18 +762,19 @@ ;; from INITARGS with which the ctor can be invoked. MATCH-P ;; true means the ctor can be used. (call-args (ctor) - (loop with match-p = t - for (key supplied-value) on initargs by #'cddr - as value = (getf (ctor-initargs ctor) key 'not-found) - while match-p - when (or (eq 'not-found value) - (and (constantp value) - (not (eql supplied-value value)))) do - (setq match-p nil) - unless (constantp value) - collect supplied-value into args - finally - (return (values args match-p))))) + (collect ((args)) + (let ((ctail (ctor-initargs ctor)) + (itail initargs)) + (loop + (when (or (null ctail) (null itail)) + (return (values (args) (and (null ctail) (null itail))))) + (unless (eq (pop ctail) (pop itail)) + (return nil)) + (let ((ival (pop itail)) (cval (pop ctail))) + (if (constantp cval) + (unless (eql cval ival) + (return nil)) + (args ival)))))))) ;; ;; Loop over all ctors of CLASS looking for a ctor that can be ;; used to construct an instance with the given initargs. If one -- GitLab