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)