Commit a01331e6 authored by pfdietz's avatar pfdietz
Browse files

Implementations may specialize the default methods for structure-objects,...

Implementations may specialize the default methods for structure-objects, standard-objects, or conditions for MAKE-LOAD-FORM, so tests make-load-form.[123] needed to be beefed up.
parent bd5ec132
......@@ -11,26 +11,49 @@
(defclass make-load-form-class-01 () (a b c))
(deftest make-load-form.1
(let* ((fun #'make-load-form)
(obj (make-instance 'make-load-form-class-01)))
(if (eql (or (find-method fun nil '(standard-object) nil)
(find-method fun nil (list (find-class t)) nil)
:none)
(car (compute-applicable-methods fun (list obj))))
;; The default method applies
(handler-case
(progn (make-load-form (make-instance 'make-load-form-class-01))
:bad)
(progn (make-load-form obj) :bad)
(error () :good))
:good))
:good)
(defstruct make-load-form-struct-02 a b c)
(deftest make-load-form.2
(let* ((fun #'make-load-form)
(obj (make-make-load-form-struct-02)))
(if (eql (or (find-method fun nil '(structure-object) nil)
(find-method fun nil (list (find-class t)) nil)
:none)
(car (compute-applicable-methods fun (list obj))))
;; The default method applies
(handler-case
(progn (make-load-form (make-make-load-form-struct-02)) :bad)
(progn (make-load-form obj) :bad)
(error () :good))
:good))
:good)
(define-condition make-load-form-condition-03 () ((a) (b) (c)))
(deftest make-load-form.3
(let* ((fun #'make-load-form)
(obj (make-condition 'make-load-form-condition-03)))
(if (eql (or (find-method fun nil '(condition) nil)
(find-method fun nil (list (find-class t)) nil)
:none)
(car (compute-applicable-methods fun (list obj))))
;; The default method applies
(handler-case
(progn (make-load-form (make-condition 'make-load-form-condition-03) :bad))
(progn (make-load-form obj :bad))
(error () :good))
:good))
:good)
;;; Make sure these errors are due to the method, not due to lack of
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment