functionp.lsp 2.2 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
;-*- 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)

18
;;; In ANSI CL, symbols can no longer be functions
19
20
21
22
23
24
25
26
27
28
(deftest functionp.2
  (functionp 'identity)
  nil)

(deftest functionp.3
  (not (functionp #'identity))
  nil)

(deftest functionp.4
  (loop for x in *cl-symbol-names*
sds's avatar
sds committed
29
30
31
32
33
34
35
36
37
        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)
38
  nil)
39
40
41
42
43

(deftest functionp.5
  (functionp '(setf car))
  nil)

44
;;; In ANSI CL, lambda forms are no longer functions
45
46
47
48
(deftest functionp.6
  (functionp '(lambda (x) x))
  nil)

49
50
(report-and-ignore-errors
 (defun (setf functionp-7-accessor) (y x) (setf (car x) y) y))
pfdietz's avatar
pfdietz committed
51
52

(deftest functionp.7
53
  (not-mv (functionp #'(setf functionp-7-accessor)))
pfdietz's avatar
pfdietz committed
54
  nil)
55
56

(deftest functionp.8
57
  (not-mv (functionp #'(lambda (x) x)))
58
59
60
  nil)

(deftest functionp.9
61
  (not-mv (functionp (compile nil '(lambda (x) x))))
62
63
  nil)

64
;;; In ANSI CL, symbols and cons can no longer be functions
65
(deftest functionp.10
66
  (check-predicate #'(lambda (x)
sds's avatar
sds committed
67
68
69
70
                       (not (and (or (numberp x) (characterp x)
                                     (symbolp x) (consp x)
                                     (typep x 'array))
                                 (functionp x)))))
71
  nil)
72
73
74
75
76
77

(deftest functionp.11
  (flet ((%f () nil)) (functionp '%f))
  nil)

(deftest functionp.12
78
  (flet ((%f () nil)) (not-mv (functionp #'%f)))
79
80
  nil)

81
82
;;; TODO: Add check-type-predicate test?

83
84
85
86
87
88
89
(deftest functionp.order.1
  (let ((i 0))
    (values
     (notnot (functionp (progn (incf i) #'cons)))
     i))
  t 1)

90
(deftest functionp.error.1
91
92
  (signals-error (functionp) program-error)
  t)
93

94
(deftest functionp.error.2
95
96
  (signals-error (functionp #'cons nil) program-error)
  t)