Traits

specializer-test.lisp

(cl:in-package #:language-extension.protocol.dispatch)

;;;

(defgeneric test (x))

(p:defprotocol (role) specializer-test ()
  (:initarg :foo role)
  (:method test ((x role))))

(defclass test-class-2 () ())

(defmethod test ((x test-class-2))
  :working)

(defclass test-class (test-class-2)
  ((%x :initarg :foo)))

(defclass unrelated () ())

(defgeneric test-2 (x y)
  (:generic-function-class protocol-generic-function))

(defmethod test-2 ((x (protocol-role role specializer-test)) (y fixnum))
  (test x))

#+later (test-2 (make-instance 'test-class))

(specializer-test-role-p 1)
(specializer-test-role-p (c2mop:class-prototype (c2mop:ensure-finalized (find-class 'test-class))))
(specializer-test-role-p (c2mop:class-prototype (c2mop:ensure-finalized (find-class 'test-class-2))))

(test-2 (make-instance 'unrelated))

(typep 1 '(protocol-role role specializer-test))
(typep (c2mop:class-prototype (find-class 'test-class)) '(protocol-role role specializer-test))