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