Skip to content
Snippets Groups Projects
Commit 10faeaa6 authored by gerd's avatar gerd
Browse files

* 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.
parent 0b148842
Branches
Tags
No related merge requests found
...@@ -46,7 +46,7 @@ ...@@ -46,7 +46,7 @@
;;; is called. ;;; is called.
(file-comment (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") (in-package "PCL")
...@@ -762,18 +762,19 @@ ...@@ -762,18 +762,19 @@
;; from INITARGS with which the ctor can be invoked. MATCH-P ;; from INITARGS with which the ctor can be invoked. MATCH-P
;; true means the ctor can be used. ;; true means the ctor can be used.
(call-args (ctor) (call-args (ctor)
(loop with match-p = t (collect ((args))
for (key supplied-value) on initargs by #'cddr (let ((ctail (ctor-initargs ctor))
as value = (getf (ctor-initargs ctor) key 'not-found) (itail initargs))
while match-p (loop
when (or (eq 'not-found value) (when (or (null ctail) (null itail))
(and (constantp value) (return (values (args) (and (null ctail) (null itail)))))
(not (eql supplied-value value)))) do (unless (eq (pop ctail) (pop itail))
(setq match-p nil) (return nil))
unless (constantp value) (let ((ival (pop itail)) (cval (pop ctail)))
collect supplied-value into args (if (constantp cval)
finally (unless (eql cval ival)
(return (values args match-p))))) (return nil))
(args ival))))))))
;; ;;
;; Loop over all ctors of CLASS looking for a ctor that can be ;; Loop over all ctors of CLASS looking for a ctor that can be
;; used to construct an instance with the given initargs. If one ;; used to construct an instance with the given initargs. If one
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment