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