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 @@ ...@@ -11,26 +11,49 @@
(defclass make-load-form-class-01 () (a b c)) (defclass make-load-form-class-01 () (a b c))
(deftest make-load-form.1 (deftest make-load-form.1
(handler-case (let* ((fun #'make-load-form)
(progn (make-load-form (make-instance 'make-load-form-class-01)) (obj (make-instance 'make-load-form-class-01)))
:bad) (if (eql (or (find-method fun nil '(standard-object) nil)
(error () :good)) (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 obj) :bad)
(error () :good))
:good))
:good) :good)
(defstruct make-load-form-struct-02 a b c) (defstruct make-load-form-struct-02 a b c)
(deftest make-load-form.2 (deftest make-load-form.2
(handler-case (let* ((fun #'make-load-form)
(progn (make-load-form (make-make-load-form-struct-02)) :bad) (obj (make-make-load-form-struct-02)))
(error () :good)) (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 obj) :bad)
(error () :good))
:good))
:good) :good)
(define-condition make-load-form-condition-03 () ((a) (b) (c))) (define-condition make-load-form-condition-03 () ((a) (b) (c)))
(deftest make-load-form.3 (deftest make-load-form.3
(handler-case (let* ((fun #'make-load-form)
(progn (make-load-form (make-condition 'make-load-form-condition-03) :bad)) (obj (make-condition 'make-load-form-condition-03)))
(error () :good)) (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 obj :bad))
(error () :good))
:good))
:good) :good)
;;; Make sure these errors are due to the method, not due to lack of ;;; 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