From 199dc8ba704a720bdcd78f8f19a1c7292a0da422 Mon Sep 17 00:00:00 2001 From: rtoy <rtoy> Date: Fri, 6 Aug 2004 17:21:54 +0000 Subject: [PATCH] Fix for make-instance bug reported by Axel Schairer on cmucl-help, 2004-08-05. (Taken from identical fix in sbcl.) --- pcl/ctor.lisp | 17 ++++++++++++++--- 1 file changed, 14 insertions(+), 3 deletions(-) diff --git a/pcl/ctor.lisp b/pcl/ctor.lisp index 830cfc646..270149b24 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.16 2003/09/03 10:17:22 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/ctor.lisp,v 1.17 2004/08/06 17:21:54 rtoy Exp $") (in-package "PCL") @@ -54,6 +54,15 @@ ;;; Utilities ******* ;;; ****************** +(defun quote-plist-keys (plist) + (loop for (key . more) on plist by #'cddr + if (null more) do + (error "Not a property list: ~S" plist) + else + collect `(quote ,key) + and collect (car more))) + + (defun plist-keys (plist &key test) (loop for (key . more) on plist by #'cddr if (null more) do @@ -402,9 +411,11 @@ collect `(funcall (truly-the function ,fn) ,args ())))) (values `(let (,@(when (or ii-before ii-after) - `((.ii-args. (list .instance. ,@initargs)))) + `((.ii-args. + (list .instance. ,@(quote-plist-keys initargs))))) ,@(when (or si-before si-after) - `((.si-args. (list .instance. t ,@initargs))))) + `((.si-args. + (list .instance. t ,@(quote-plist-keys initargs)))))) ,@(method-calls ii-before '.ii-args.) ,@(method-calls si-before '.si-args.) ,slot-inits -- GitLab