11 |
(defclass make-load-form-class-01 () (a b c)) |
(defclass make-load-form-class-01 () (a b c)) |
12 |
|
|
13 |
(deftest make-load-form.1 |
(deftest make-load-form.1 |
14 |
(handler-case |
(let* ((fun #'make-load-form) |
15 |
(progn (make-load-form (make-instance 'make-load-form-class-01)) |
(obj (make-instance 'make-load-form-class-01))) |
16 |
:bad) |
(if (eql (or (find-method fun nil '(standard-object) nil) |
17 |
(error () :good)) |
(find-method fun nil (list (find-class t)) nil) |
18 |
|
:none) |
19 |
|
(car (compute-applicable-methods fun (list obj)))) |
20 |
|
;; The default method applies |
21 |
|
(handler-case |
22 |
|
(progn (make-load-form obj) :bad) |
23 |
|
(error () :good)) |
24 |
|
:good)) |
25 |
:good) |
:good) |
26 |
|
|
27 |
(defstruct make-load-form-struct-02 a b c) |
(defstruct make-load-form-struct-02 a b c) |
28 |
|
|
29 |
(deftest make-load-form.2 |
(deftest make-load-form.2 |
30 |
(handler-case |
(let* ((fun #'make-load-form) |
31 |
(progn (make-load-form (make-make-load-form-struct-02)) :bad) |
(obj (make-make-load-form-struct-02))) |
32 |
(error () :good)) |
(if (eql (or (find-method fun nil '(structure-object) nil) |
33 |
|
(find-method fun nil (list (find-class t)) nil) |
34 |
|
:none) |
35 |
|
(car (compute-applicable-methods fun (list obj)))) |
36 |
|
;; The default method applies |
37 |
|
(handler-case |
38 |
|
(progn (make-load-form obj) :bad) |
39 |
|
(error () :good)) |
40 |
|
:good)) |
41 |
:good) |
:good) |
42 |
|
|
43 |
(define-condition make-load-form-condition-03 () ((a) (b) (c))) |
(define-condition make-load-form-condition-03 () ((a) (b) (c))) |
44 |
|
|
45 |
(deftest make-load-form.3 |
(deftest make-load-form.3 |
46 |
(handler-case |
(let* ((fun #'make-load-form) |
47 |
(progn (make-load-form (make-condition 'make-load-form-condition-03) :bad)) |
(obj (make-condition 'make-load-form-condition-03))) |
48 |
(error () :good)) |
(if (eql (or (find-method fun nil '(condition) nil) |
49 |
|
(find-method fun nil (list (find-class t)) nil) |
50 |
|
:none) |
51 |
|
(car (compute-applicable-methods fun (list obj)))) |
52 |
|
;; The default method applies |
53 |
|
(handler-case |
54 |
|
(progn (make-load-form obj :bad)) |
55 |
|
(error () :good)) |
56 |
|
:good)) |
57 |
:good) |
:good) |
58 |
|
|
59 |
;;; 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 |