6 |
(in-package :cl-test) |
(in-package :cl-test) |
7 |
|
|
8 |
(deftest ensure-generic-function.1 |
(deftest ensure-generic-function.1 |
9 |
(signals-error (ensure-generic-function 'car) error) |
(if (typep #'car 'generic-function) |
10 |
|
t |
11 |
|
(signals-error (ensure-generic-function 'car) error)) |
12 |
t) |
t) |
13 |
|
|
14 |
(deftest ensure-generic-function.2 |
(deftest ensure-generic-function.2 |
58 |
error)))) |
error)))) |
59 |
nil t t t) |
nil t t t) |
60 |
|
|
61 |
|
(deftest ensure-generic-function.7 |
62 |
|
(let ((f 'egf-fun-7)) |
63 |
|
(when (fboundp f) (fmakunbound f)) |
64 |
|
(let ((fn (eval `(defgeneric ,f (x) |
65 |
|
(:method ((x symbol)) (list x :a)) |
66 |
|
(:method ((x integer)) (list x :b)) |
67 |
|
(:method ((x t)) (list x :c)))))) |
68 |
|
(values |
69 |
|
(mapcar fn '(x 2 3/2)) |
70 |
|
(eqlt fn (ensure-generic-function f :lambda-list '(x))) |
71 |
|
(mapcar fn '(x 2 3/2))))) |
72 |
|
((x :a) (2 :b) (3/2 :c)) |
73 |
|
t |
74 |
|
((x :a) (2 :b) (3/2 :c))) |
75 |
|
|
76 |
|
(deftest ensure-generic-function.8 |
77 |
|
(let ((f 'egf-fun-8)) |
78 |
|
(when (fboundp f) (fmakunbound f)) |
79 |
|
(let ((fn (eval `(defgeneric ,f (x y) |
80 |
|
(:method ((x t) (y symbol)) 1) |
81 |
|
(:method ((x symbol) (y t)) 2))))) |
82 |
|
(values |
83 |
|
(mapcar fn '(a a 3) '(b 4 b)) |
84 |
|
(eqlt fn (ensure-generic-function f :lambda-list '(x y) |
85 |
|
:argument-precedence-order '(y x))) |
86 |
|
(mapcar fn '(a a 3) '(b 4 b))))) |
87 |
|
(2 2 1) |
88 |
|
t |
89 |
|
(1 2 1)) |
90 |
|
|
91 |
|
(deftest ensure-generic-function.9 |
92 |
|
(let ((f 'egf-fun-9)) |
93 |
|
(when (fboundp f) (fmakunbound f)) |
94 |
|
(let ((fn (eval `(defgeneric ,f (x) |
95 |
|
(:method-combination +) |
96 |
|
(:method + ((x t)) 1) |
97 |
|
(:method + ((x symbol)) 2) |
98 |
|
(:method + ((x (eql nil))) 4))))) |
99 |
|
(values |
100 |
|
(mapcar fn '(3/2 a nil)) |
101 |
|
(eqlt fn (ensure-generic-function f :lambda-list '(x) |
102 |
|
:method-class 'standard-method)) |
103 |
|
(mapcar fn '(3/2 a nil)) |
104 |
|
(eqlt fn (ensure-generic-function f :lambda-list '(x) |
105 |
|
:method-class |
106 |
|
(find-class 'standard-method))) |
107 |
|
(mapcar fn '(3/2 a nil))))) |
108 |
|
|
109 |
|
|
110 |
|
(1 3 7) |
111 |
|
t |
112 |
|
(1 3 7) |
113 |
|
t |
114 |
|
(1 3 7)) |
115 |
|
|
116 |
|
(deftest ensure-generic-function.10 |
117 |
|
(let ((f 'egf-fun-10)) |
118 |
|
(when (fboundp f) (fmakunbound f)) |
119 |
|
(let ((fn (eval `(defgeneric ,f (x) |
120 |
|
(:method ((x t)) 1))))) |
121 |
|
(values |
122 |
|
(funcall fn 'a) |
123 |
|
(eqlt fn (ensure-generic-function f :lambda-list '(x) |
124 |
|
:generic-function-class |
125 |
|
'standard-generic-function)) |
126 |
|
(funcall fn 'a) |
127 |
|
(eqlt fn (ensure-generic-function f :lambda-list '(x) |
128 |
|
:generic-function-class |
129 |
|
(find-class 'standard-generic-function))) |
130 |
|
(funcall fn 'a)))) |
131 |
|
1 t 1 t 1) |
132 |
|
|
133 |
|
|
134 |
;;; Many more tests are needed for other combinations of keyword parameters |
;;; Many more tests are needed for other combinations of keyword parameters |
135 |
|
|
136 |
(deftest ensure-generic-function.error.1 |
(deftest ensure-generic-function.error.1 |