Skip to content
Snippets Groups Projects
Commit 3bbc7259 authored by gerd's avatar gerd
Browse files

Structure slot names can be any symbol. Found by Paul Dietz.

	* src/pcl/std-class.lisp (*allow-funny-slot-names*): Renamed
	from *allow-keyword-slot-names*.

	* src/pcl/methods.lisp (legal-slot-name-p): Allow any symbol
	if *allow-funny-slot-names* is true.
	(shared-initialize): Print the value of the :slot-name initarg.

	* src/code/defstruct.lisp (parse-1-dsd): Treat nil as symbol
	when used as a slot name.
parent 0c1eb5c1
No related branches found
No related tags found
No related merge requests found
......@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/defstruct.lisp,v 1.87 2003/05/20 18:39:36 gerd Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/defstruct.lisp,v 1.88 2003/05/28 08:50:41 gerd Exp $")
;;;
;;; **********************************************************************
;;;
......@@ -669,7 +669,7 @@
(islot (make-defstruct-slot-description
:name nil :index 0 :type t)))
(multiple-value-bind (name default default-p type type-p read-only ro-p)
(cond ((listp spec)
(cond ((consp spec)
(destructuring-bind (name &optional (default nil default-p)
&key (type nil type-p)
(read-only nil ro-p))
......
......@@ -26,7 +26,7 @@
;;;
(file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/methods.lisp,v 1.34 2003/05/25 17:01:51 gerd Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/methods.lisp,v 1.35 2003/05/28 08:50:39 gerd Exp $")
(in-package :pcl)
......@@ -227,10 +227,11 @@
(defmethod legal-slot-name-p ((object standard-method) x)
(cond ((not (symbolp x))
"is not a symbol and so cannot be bound")
;;
;; Structure slots names can be any symbol.
(*allow-funny-slot-names*)
((keywordp x)
(if *allow-keyword-slot-names*
t
"is a keyword and so cannot be bound"))
"is a keyword and so cannot be bound")
((memq x '(t nil))
"cannot be bound")
((constantp x)
......@@ -259,7 +260,8 @@
(unless slot-definition
(let ((legalp (legal-slot-name-p method slot-name)))
(unless (eq legalp t)
(error "The value of the ~s initarg ~A." :slot-name legalp)))))
(error "The value of the ~s initarg, ~s, ~A."
:slot-name slot-name legalp)))))
(defmethod shared-initialize :after ((method standard-method) slot-names
&rest initargs
......
......@@ -26,7 +26,7 @@
;;;
(file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/std-class.lisp,v 1.67 2003/05/25 14:33:49 gerd Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/std-class.lisp,v 1.68 2003/05/28 08:50:39 gerd Exp $")
(in-package :pcl)
......@@ -1064,11 +1064,11 @@
(mapc #'initialize-internal-slot-functions eslotds)
eslotds))
(defvar *allow-keyword-slot-names* nil)
(defvar *allow-funny-slot-names* nil)
(defmethod initialize-internal-slot-functions :around
((slotd structure-effective-slot-definition))
(let ((*allow-keyword-slot-names* t))
(let ((*allow-funny-slot-names* t))
(call-next-method)))
(defmethod compute-effective-slot-definition
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment