/[gcl]/gcl/ansi-tests/ensure-generic-function.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/ensure-generic-function.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.4 by pfdietz, Sat Jan 17 23:15:54 2004 UTC revision 1.5 by pfdietz, Tue Apr 26 02:29:48 2005 UTC
# Line 6  Line 6 
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
# Line 56  Line 58 
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

Legend:
Removed from v.1.4  
changed lines
  Added in v.1.5

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26