fboundp.lsp 2.15 KB
Newer Older
1 2 3 4 5 6 7 8
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Mon Oct  7 22:37:22 2002
;;;; Contains: Tests of FBOUNDP

(in-package :cl-test)

(deftest fboundp.1
9
  (not-mv (fboundp 'car))
10 11 12
  nil)

(deftest fboundp.2
13
  (not-mv (fboundp 'cdr))
14 15 16
  nil)

(deftest fboundp.3
17
  (not-mv (fboundp 'defun))  ; a macro
18 19 20 21 22 23 24 25 26
  nil)

(deftest fboundp.4
  ;; fresh symbols are not fbound
  (let ((g (gensym))) (fboundp g))
  nil)

(defun fboundp-5-fn (x) x)
(deftest fboundp.5
27
  (not-mv (fboundp 'fboundp-5-fn))
28 29
  nil)

30 31
(report-and-ignore-errors
 (defun (setf fboundp-6-accessor) (y x) (setf (car x) y)))
32 33

(deftest fboundp.6
34
  (not-mv (fboundp '(setf fboundp-6-accessor)))
35 36 37 38 39 40
  nil)

(deftest fboundp.7
  (let ((g (gensym))) (fboundp (list 'setf g)))
  nil)

41 42 43
;;; See 11.1.2.1.1
(deftest fboundp.8
  (loop for x in *cl-non-function-macro-special-operator-symbols*
sds's avatar
sds committed
44 45
        when (and (fboundp x) (not (eq x 'ed)))
        collect x)
46 47
  nil)

48 49 50 51 52
(deftest fboundp.order.1
  (let ((i 0))
    (values (notnot (fboundp (progn (incf i) 'car))) i))
  t 1)

53
(deftest fboundp.error.1
54 55
  (check-type-error #'fboundp #'(lambda (x) (typep x '(or symbol (cons (eql setf) (cons symbol null))))))
  nil)
56

57
(deftest fboundp.error.2
58
  (signals-type-error x '(x) (fboundp x))
59
  t)
60

61
(deftest fboundp.error.3
62
  (signals-type-error x '(setf) (fboundp x))
63
  t)
64

65
(deftest fboundp.error.4
66
  (signals-type-error x '(setf foo . bar) (fboundp x))
67
  t)
68

69
(deftest fboundp.error.5
70
  (signals-type-error x '(setf foo bar) (fboundp x))
71
  t)
72 73

(deftest fboundp.error.6
74 75 76 77 78 79 80 81
  (signals-error (fboundp) program-error)
  t)

(deftest fboundp.error.7
  (signals-error (fboundp 'cons nil) program-error)
  t)

(deftest fboundp.error.8
82 83
  (signals-error (locally (fboundp 1) t) type-error)
  t)
84 85 86 87 88 89

(deftest fboundp.error.9
  (signals-type-error x '(setf . foo) (fboundp x))
  t)

(deftest fboundp.error.10
90
  (loop for x in *mini-universe*
sds's avatar
sds committed
91 92 93 94 95 96 97 98 99
        unless (symbolp x)
        nconc
        (handler-case
         (list x (fboundp `(setf ,x)))
         (type-error (c)
                     (assert (not (typep (type-error-datum c)
                                         (type-error-expected-type c))))
                     nil)
         (error (c) (list (list x c)))))
100
  nil)
101