source: trunk/source/tests/ansi-tests/function.lsp @ 8991

Last change on this file since 8991 was 8991, checked in by gz, 11 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

File size: 4.8 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Mon Oct  7 07:34:29 2002
4;;;; Contains: Tests for type FUNCTION and the special form FUNCTION
5
6(in-package :cl-test)
7
8;;;
9;;; Note! There are significant incompatibilities between CLTL1 and ANSI CL
10;;; in the meaning of FUNCTION and FUNCTIONP.
11;;;
12
13(deftest function.1
14  (typep nil 'function)
15  nil)
16
17;;; The next test demonstrates an incompatibility between CLtL1 and ANSI CL.
18;;; In ANSI CL, symbols are no longer of type FUNCTION.
19(deftest function.2
20  (typep 'identity 'function)
21  nil)
22
23(deftest function.3
24  (not-mv (typep #'identity 'function))
25  nil)
26
27(deftest function.4
28  (loop for x in *cl-symbol-names*
29        for s = (find-symbol x "CL")
30        for f = (and (fboundp s)
31                     (symbol-function s)
32                     (not (special-operator-p s))
33                     (not (macro-function s))
34                     (symbol-function s))
35        unless (or (null f)
36                   (typep f 'function))
37        collect x)
38  nil)
39
40(deftest function.5
41  (typep '(setf car) 'function)
42  nil)
43
44;;; The next test demonstrates an incompatibility between CLtL1 and ANSI CL.
45;;; In ANSI CL, lambda forms are no longer of type FUNCTION.
46(deftest function.6
47  (typep '(lambda (x) x) 'function)
48  nil)
49
50(report-and-ignore-errors
51 (defun (setf function-7-accessor) (y x) (setf (car x) y) y))
52
53(deftest function.7
54  (not-mv (typep #'(setf function-7-accessor) 'function))
55  nil)
56
57(deftest function.8
58  (not-mv (typep #'(lambda (x) x) 'function))
59  nil)
60
61(deftest function.9
62  (not-mv (typep (compile nil '(lambda (x) x)) 'function))
63  nil)
64
65;;; The next test demonstrates an incompatibility between CLtL1 and ANSI CL.
66;;; In ANSI CL, symbols and cons can no longer also be of type FUNCTION.
67(deftest function.10
68  (check-predicate (typef '(not (and (or number character symbol
69                                         cons array)
70                                     function))))
71  nil)
72
73(deftest function.11
74  (flet ((%f () nil)) (typep '%f 'function))
75  nil)
76
77(deftest function.12
78  (flet ((%f () nil)) (not-mv (typep #'%f 'function)))
79  nil)
80
81(deftest function.13
82  (labels ((%f () nil)) (not-mv (typep #'%f 'function)))
83  nil)
84
85;;; "If name is a function name, the functional definition of that
86;;; name is that established by the innermost lexically enclosing flet,
87;;; labels, or macrolet form, if there is one." (page for FUNCTION, sec. 5.3)
88;;;            ^^^^^^^^
89;;;(deftest function.14
90;;;  (macrolet ((%f () nil)) (not-mv (typep #'%f 'function)))
91;;;  nil)
92
93;;; Tests of FUNCTION type specifiers
94
95(deftest function.14
96  (flet ((%f () nil))
97    (declare (optimize safety debug))
98    (let ((f #'%f))
99      (declare (type (function () null) f))
100      (funcall f)))
101  nil)
102
103(deftest function.15
104  (flet ((%f (x) (declare (ignore x)) nil))
105    (declare (ftype (function (nil) nil) %f))
106    :good)
107  :good)
108
109(deftest function.16
110  (flet ((%f (x) (declare (ignore x)) nil))
111    (declare (ftype (function (t) null) %f))
112    (values
113     (%f 'a)
114     (locally (declare (ftype (function (integer) t) %f))
115              (%f 10))
116     (%f 'b)))
117  nil nil nil)
118
119(deftest function.17
120  (flet ((%f (&optional x) x))
121    (declare (ftype (function (&optional integer) t) %f))
122    (values (%f) (%f 10) (%f) (%f (1+ most-positive-fixnum))))
123  nil 10 nil #.(1+ most-positive-fixnum))
124
125(deftest function.18
126  (flet ((%f (&rest x) x))
127    (declare (ftype (function (&rest symbol) t) %f))
128    (values (%f) (%f 'a) (%f 'a 'b 'c)))
129  () (a) (a b c))
130
131(deftest function.19
132  (flet ((%f (&key foo bar) (list foo bar)))
133    (declare (ftype (function (&key (:foo t) (:bar t)) list) %f))
134    (values
135     (%f) (%f :foo 1)
136     (%f :foo 1 :foo 2)
137     (%f :bar 'a)
138     (%f :bar 'a :bar 'b)
139     (%f :foo 'x :bar 'y)
140     (%f :bar 'x :foo 'y)
141     (%f :bar 'x :foo 'y :bar 'z :foo 'w)
142     ))
143  (nil nil)
144  (1 nil)
145  (1 nil)
146  (nil a)
147  (nil a)
148  (x y)
149  (y x)
150  (y x))
151
152(deftest function.20
153  (flet ((%f (&key foo) foo))
154    (declare (ftype (function (&key (:foo t) (:allow-other-keys t)) t) %f))
155    (values (%f) (%f :foo 'a) (%f :allow-other-keys nil)
156            (%f :allow-other-keys t :foo 'z)))
157  nil a nil z)
158
159(deftest function.21
160  (flet ((%f (&key foo &allow-other-keys) foo))
161    (declare (ftype (function (&key (:foo integer)) t) %f))
162    (values (%f) (%f :foo 123)))
163  nil 123)
164
165(deftest function.22
166  (flet ((%f (&key foo &allow-other-keys) foo))
167    (declare (ftype (function (&key (:foo integer) (:bar t)) t) %f))
168    (values (%f) (%f :foo 123) (%f :bar 'x) (%f :foo 12 :bar 'y)))
169  nil 123 nil 12)
170
171(deftest function.23
172  (flet ((%f (&key foo &allow-other-keys) foo))
173    (declare (ftype (function (&key (:foo integer) &allow-other-keys) t) %f))
174    (values (%f) (%f :foo 123) (%f :bar 'x) (%f :foo 12 :bar 'y)))
175  nil 123 nil 12)
176
177(deftest function.24
178  (flet ((%f (&rest r &key foo bar) (list r foo bar)))
179    (declare (ftype (function (&rest symbol &key (:foo t) (:bar t)) list) %f))
180    (values (%f) (%f :foo 'a) (%f :bar 'b) (%f :bar 'd :foo 'c)))
181  (nil nil nil)
182  ((:foo a) a nil)
183  ((:bar b) nil b)
184  ((:bar d :foo c) c d))
Note: See TracBrowser for help on using the repository browser.