Ticket #152: mop-issues.lisp

(defclass foo-class (standard-class)
  ())

;;;
;;; Issue 1:
;;;
;;; It seems ABCL doesn't require an implementation of this method
;;; for metaclasses to work properly? It's definitely needed on SBCL
;;; and the closer-mop package provides it.
;;;
;;; It's commented out in order to make the program run.
;;;
#+nil(defmethod mop:validate-superclass ((class foo-class) (superclass standard-object))
  t)

(defclass foo-slot-mixin ()
  ((field-data :initarg :field-data
               :initform 'abc
               :accessor field-data)))

(defclass foo-direct-slot-definition (foo-slot-mixin mop:standard-direct-slot-definition)
  ())

(defclass foo-effective-slot-definition (foo-slot-mixin mop:standard-effective-slot-definition)
  ())

;;;
;;; Issue 2:
;;;
;;; The following two methods require me to use the double-: as they
;;; are not exported.
;;;
(defmethod mop::direct-slot-definition-class ((class foo-class) &rest initargs)
  (format t "getting dir class. initargs=~s~%" initargs)
  (find-class 'foo-direct-slot-definition))

(defmethod mop::effective-slot-definition-class ((class foo-class) &rest initargs)
  (format t "getting eff class. initargs=~s~%" initargs)
  (find-class 'foo-effective-slot-definition))

;;;
;;; Issue 3:
;;;
;;; Similar to issue 2, I need to use double-: here.
;;;
(defmethod mop::compute-effective-slot-definition ((class foo-class) slot-name direct-slots)
  (format t "computing slot definition: class=~s name=~s slots=~s~%"
          class slot-name direct-slots)
  (let ((result (call-next-method)))
    (format t "    result: ~s~%" result)
    result))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defclass bar ()
  ((value :initarg :value
          :accessor bar-value
          :field-data 'some-value))
  (:metaclass foo-class))

(defun test-metaclass ()
  ;;
  ;; Issue 4:
  ;;
  ;; The following call to MAKE-INSTANCE will fail with an error saying that :VALUE
  ;; is not a valid initialiser:
  ;;
  ;; Invalid initarg :VALUE.
  ;; [Condition of type PROGRAM-ERROR]
  ;;
  (let ((v (make-instance 'bar :value 10)))
    ;;
    ;; Issue 5:
    ;;
    ;; If I comment out the ":value 10" part above, in order to get the thing to run,
    ;; the below code will return NIL. It appears MOP:CLASS-SLOTS returns NIL
    ;; instead of a list of slots.
    ;;
    (dolist (s (mop:class-slots (class-of v)))
      (format t "slot ~s = ~s~%"
              (mop:slot-definition-name s)
              ;; The below dereferencing of the FIELD-DATA slot causes the following error:
              ;;
              ;; The slot FIELD-DATA is unbound in the object #<FOO-EFFECTIVE-SLOT-DEFINITION VALUE>.
              ;; [Condition of type UNBOUND-SLOT]
              (field-data s)))))