/[gcl]/gcl/ansi-tests/complement.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/complement.lsp

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

revision 1.8 by pfdietz, Sat Jan 17 12:05:41 2004 UTC revision 1.9 by pfdietz, Wed Jun 15 12:52:58 2005 UTC
# Line 31  Line 31 
31    (notnot-mv (complement #'identity))    (notnot-mv (complement #'identity))
32    t)    t)
33    
34    (deftest complement.6
35      (flet ((%f (&rest args) (notnot (evenp (length args)))))
36        (let ((cf (complement #'%f)))
37          (values
38           (%f) (%f 'a) (%f 'a 'b) (%f 'a 'b 'c)
39           (funcall cf) (funcall cf 'a) (funcall cf 'a 'b) (funcall cf 'a 'b 'c))))
40      t nil t nil
41      nil t nil t)
42    
43    (deftest complement.7
44      (flet ((%f (&optional x y) (if x (not y) y)))
45        (let ((cf (complement #'%f)))
46          (values
47           (%f) (%f nil) (%f t) (%f nil nil) (%f t nil) (%f nil t) (%f t t)
48           (funcall cf) (funcall cf nil) (funcall cf t)
49           (funcall cf nil nil) (funcall cf t nil)
50           (funcall cf nil t) (funcall cf t t))))
51      nil nil t nil t t nil
52      t t nil t nil nil t)
53    
54    (deftest complement.8
55      (flet ((%f (&key x y) (if x (not y) y)))
56        (let ((cf (complement #'%f)))
57          (values
58           (list
59           (%f)
60           (%f :x nil) (%f :x t)
61           (%f :y nil) (%f :y t :y nil)
62           (%f :x nil :y nil) (%f :x t :y nil)
63           (%f :y t :x nil) (%f :x t :y t))
64          
65           (list
66            (funcall cf) (funcall cf :x nil) (funcall cf :x t)
67            (funcall cf :y nil) (funcall cf :y t)
68            (funcall cf :x nil :y nil) (funcall cf :x t :y nil)
69            (funcall cf :y t :x nil) (funcall cf :x t :y t :x nil))
70           (list
71            (funcall cf :x nil :y t :foo nil :allow-other-keys t)
72            (funcall cf :x nil :y t :allow-other-keys nil)))))
73      (nil nil t nil t nil t t nil)
74      (t t nil t nil t nil nil t)
75      (nil nil))
76    
77    (deftest complement.9
78      (let ((sym (gensym)))
79        (eval `(defgeneric ,sym (x y)))
80        (eval `(defmethod ,sym ((x integer) (y integer)) (evenp (+ x y))))
81        (eval `(defmethod ,sym ((x t) (y t)) nil))
82        (let ((cf (complement (symbol-function sym))))
83          (values (funcall cf 'a 'b)
84                  (funcall cf 0 0)
85                  (funcall cf 0 1)
86                  (funcall cf 1 0)
87                  (funcall cf 1 1))))
88      t nil t t nil)
89    
90    (deftest complement.10
91      (let ((cf (complement (compile nil '(lambda (x y) (evenp (+ x y)))))))
92        (values (funcall cf 0 0)
93                (funcall cf 0 1)
94                (funcall cf 1 0)
95                (funcall cf 1 1)))
96      nil t t nil)    
97    
98  (deftest complement.order.1  (deftest complement.order.1
99    (let ((i 0))    (let ((i 0))
100      (let ((fn (complement (progn (incf i) #'null))))      (let ((fn (complement (progn (incf i) #'null))))
# Line 40  Line 104 
104         i)))         i)))
105    1 (t t nil t t nil t nil) 1)    1 (t t nil t t nil t nil) 1)
106    
107    ;;; Error tests
108    
109  (deftest complement.error.1  (deftest complement.error.1
110    (signals-error (complement) program-error)    (signals-error (complement) program-error)
111    t)    t)
# Line 57  Line 123 
123    (signals-error (funcall (complement #'identity) t t)    (signals-error (funcall (complement #'identity) t t)
124                   program-error)                   program-error)
125    t)    t)
126    
127    (deftest complement.error.5
128      (signals-error (funcall (complement #'(lambda (&key) t)) :foo t) program-error)
129      t)
130    
131    (deftest complement.error.6
132      (signals-error (funcall (complement #'(lambda (&key) t)) :allow-other-keys nil
133                              :allow-other-keys t :foo t) program-error)
134      t)
135    
136    (deftest complement.error.7
137      (signals-error (funcall (complement #'(lambda (x &rest y) (and x (evenp (length y))))))
138                     program-error)
139      t)

Legend:
Removed from v.1.8  
changed lines
  Added in v.1.9

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