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

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

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

File size: 2.0 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Mon Oct  7 06:39:21 2002
4;;;; Contains: Tests for FUNCTIONP
5
6(in-package :cl-test)
7
8;;;
9;;; Note!  FUNCTIONP and FUNCTION behave differently in ANSI CL than
10;;; in CLTL1.  In particular, symbols and various lists are no longer
11;;; in the class FUNCTION in ANSI CL.
12;;;
13
14(deftest functionp.1
15  (functionp nil)
16  nil)
17
18;;; In ANSI CL, symbols can no longer be functions
19(deftest functionp.2
20  (functionp 'identity)
21  nil)
22
23(deftest functionp.3
24  (not (functionp #'identity))
25  nil)
26
27(deftest functionp.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                   (functionp f))
37        collect x)
38  nil)
39
40(deftest functionp.5
41  (functionp '(setf car))
42  nil)
43
44;;; In ANSI CL, lambda forms are no longer functions
45(deftest functionp.6
46  (functionp '(lambda (x) x))
47  nil)
48
49(report-and-ignore-errors
50 (defun (setf functionp-7-accessor) (y x) (setf (car x) y) y))
51
52(deftest functionp.7
53  (not-mv (functionp #'(setf functionp-7-accessor)))
54  nil)
55
56(deftest functionp.8
57  (not-mv (functionp #'(lambda (x) x)))
58  nil)
59
60(deftest functionp.9
61  (not-mv (functionp (compile nil '(lambda (x) x))))
62  nil)
63
64;;; In ANSI CL, symbols and cons can no longer be functions
65(deftest functionp.10
66  (check-predicate #'(lambda (x)
67                       (not (and (or (numberp x) (characterp x)
68                                     (symbolp x) (consp x)
69                                     (typep x 'array))
70                                 (functionp x)))))
71  nil)
72
73(deftest functionp.11
74  (flet ((%f () nil)) (functionp '%f))
75  nil)
76
77(deftest functionp.12
78  (flet ((%f () nil)) (not-mv (functionp #'%f)))
79  nil)
80
81;;; TODO: Add check-type-predicate test?
82
83(deftest functionp.order.1
84  (let ((i 0))
85    (values
86     (notnot (functionp (progn (incf i) #'cons)))
87     i))
88  t 1)
89
90(deftest functionp.error.1
91  (signals-error (functionp) program-error)
92  t)
93
94(deftest functionp.error.2
95  (signals-error (functionp #'cons nil) program-error)
96  t)
Note: See TracBrowser for help on using the repository browser.