missing error when a slot-definition is created with a bogus or missing name

[Nikodemus Siivola]

(reported by Bruno Haible)

The MOP says about slot-definition initialization:

"The :NAME argument is a slot name. An ERROR is SIGNALled if this argument
is not a symbol which can be used as a variable name. An ERROR is SIGNALled
if this argument is not supplied."

CL-USER> (make-instance 'sb-mop:standard-direct-slot-definition)
#<SB-MOP:STANDARD-DIRECT-SLOT-DEFINITION NIL {11BC9091}>
CL-USER> (make-instance 'sb-mop:standard-direct-slot-definition :name 'pi)
#<SB-MOP:STANDARD-DIRECT-SLOT-DEFINITION PI>
CL-USER> (make-instance 'sb-mop:standard-direct-slot-definition :name 123)
#<SB-MOP:STANDARD-DIRECT-SLOT-DEFINITION 123>

[Roman Brenes (roman-brenes)]

These changes seem to fix it for me,

--- src/pcl/init.lisp 2009-06-02 11:33:52.000000000 -0700
+++ ../init.lisp 2009-07-03 05:18:06.000000000 -0700
@@ -1,3 +1,4 @@
+
 ;;;; This file defines the initialization and related protocols.

 ;;;; This software is part of the SBCL system. See the README file for
@@ -25,7 +26,10 @@

 (in-package "SB-PCL")

-(defmethod make-instance ((class symbol) &rest initargs)
+(defmethod make-instance ((class symbol) &rest initargs &key (name nil) &allow-other-keys)
+ (declare (type (or symbol null) name))
+ (unless name
+ (error "The name slot is unspecified."))
   (apply #'make-instance (find-class class) initargs))

 (defmethod make-instance ((class class) &rest initargs)

[Nikodemus Siivola (nikodemus)]

This is unfortunately the wrong place to fix this. Consider:

;;; Perfectly legal
(defclass foo ()
  ((name :initarg :name)))

(make-instance 'foo :name nil)

;;; Should signal an error
(make-instance (find-class 'sb-mop:standard-direct-slot-definition))

I think the right place to do this check (and others mandated by AMOP, see "Initialization of Slot Definition Metaobjects" at http://www.lisp.org/mop/dictionary.html) is eg. in the primary on either INITIALIZE-INSTANCE (SLOT-DEFINITION).

[Roman Brenes (roman-brenes)]

Nikodemus, thanks for pointing me in the right direction. Here's a new patch for this bug along with my rationale for it, given that it is a compliance bug. Unfortunately the patch has a rather drastic effect on performance (see timing at the end) so you might want to keep it on the back burner. Any suggestions welcome.

dpANS does mentions in section "7.1.6 Initialize-Instance" that:

During initialization, initialize-instance is invoked after the following actions have been taken:
 ...
 * The validity of the defaulted initialization argument list has been checked. If any of the initialization arguments has not been declared as valid, an error is signaled.
 ...

But, on reading section "7.1.2 Declaring the Validity of Initialization Arguments" it seems that the narrow definition of the term "valid" applies to a different context and might not apply to the checks of the :NAME argument as required by the MOP for slot-definition initialization. If this is indeed the case, then as previously suggested by you, initialize-instance is a more appropriate method to effect this check than make-instance.

Also, wrt. defining the phrase "a symbol which can be used as a variable name." as mentioned in the text of this bug I could only find http://coding.derkeiler.com/Archive/Lisp/comp.lang.lisp/2006-03/msg00408.html which I have taken to mean that the predicate CONSTANTP will be null for such symbols.

Finally, I was not sure whether the phrasing of the MOP requires the use of "signal" or "error" but, I opted for "error" as otherwise if *break-on-signal* is null the restrictions of the MOP are silently ignored which didn't seem appropriate.

diff --git a/src/pcl/init.lisp b/src/pcl/init.lisp
index a4c3dad..809c04f 100644
--- a/src/pcl/init.lisp
+++ b/src/pcl/init.lisp
@@ -56,6 +56,14 @@
         finally
           (return (append supplied-initargs default-initargs))))

+(defmethod initialize-instance :before ((class slot-definition) &rest initargs)
+ (let* ((name-arg (member :name initargs :test #'eq))
+ (name-value (cadr name-arg)))
+ (unless name-arg
+ (error "INITIALIZE-INSTANCE (SLOT-DEFINITION) requires a :NAME argument (see AMOP chapter 6)"))
+ (if (constantp name-value)
+ (error "INITIALIZE-INSTANCE (SLOT-DEFINITION) disallows a named constant/defconstant as the value of :NAME but was given ~S (see AMOP chapter 6)" name-value))))
+
 (defmethod initialize-instance ((instance slot-object) &rest initargs)
   (apply #'shared-initialize instance t initargs))

========================== Timing on sbcl-1.0.29 =========================
Before defining the :before method

* (time (dotimes (x 100000000) (make-instance 'sb-mop:standard-direct-slot-definition :name 'anonymous)))

Evaluation took:
  19.969 seconds of real time
  19.973249 seconds of total run time (19.725233 user, 0.248016 system)
  [ Run times consist of 2.629 seconds GC time, and 17.345 seconds non-GC time. ]
  100.02% CPU
  39,837,001,524 processor cycles
  14,399,961,184 bytes consed

After defining the :before method

* (time (dotimes (x 100000000) (make-instance 'sb-mop:standard-direct-slot-definition :name 'anonymous)))

Evaluation took:
  72.245 seconds...

[Christophe Rhodes (csr21-cantab)]

Reviewing the patch in comment #3:

* I would use &key (name nil namep) rather than the member
  test in the lambda list;
* the error should be a reference condition, using
  '(:amop :initialization slot-definition) as one of the references;
* if we're going to do this, we should at least try to perform all
  the intialization checks referred to at once;
* I'm not worried about the slowdown; I don't think the bottleneck
  in any application is likely to be the creation of slotds.