source: trunk/source/tests/ansi-tests/fboundp.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 22:37:22 2002
4;;;; Contains: Tests of FBOUNDP
5
6(in-package :cl-test)
7
8(deftest fboundp.1
9  (not-mv (fboundp 'car))
10  nil)
11
12(deftest fboundp.2
13  (not-mv (fboundp 'cdr))
14  nil)
15
16(deftest fboundp.3
17  (not-mv (fboundp 'defun))  ; a macro
18  nil)
19
20(deftest fboundp.4
21  ;; fresh symbols are not fbound
22  (let ((g (gensym))) (fboundp g))
23  nil)
24
25(defun fboundp-5-fn (x) x)
26(deftest fboundp.5
27  (not-mv (fboundp 'fboundp-5-fn))
28  nil)
29
30(report-and-ignore-errors
31 (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  nil)
36
37(deftest fboundp.7
38  (let ((g (gensym))) (fboundp (list 'setf g)))
39  nil)
40
41;;; See 11.1.2.1.1
42(deftest fboundp.8
43  (loop for x in *cl-non-function-macro-special-operator-symbols*
44        when (and (fboundp x) (not (eq x 'ed)))
45        collect x)
46  nil)
47
48(deftest fboundp.order.1
49  (let ((i 0))
50    (values (notnot (fboundp (progn (incf i) 'car))) i))
51  t 1)
52
53(deftest fboundp.error.1
54  (check-type-error #'fboundp #'(lambda (x) (typep x '(or symbol (cons (eql setf) (cons symbol null))))))
55  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  (signals-error (fboundp) program-error)
75  t)
76
77(deftest fboundp.error.7
78  (signals-error (fboundp 'cons nil) program-error)
79  t)
80
81(deftest fboundp.error.8
82  (signals-error (locally (fboundp 1) t) type-error)
83  t)
84
85(deftest fboundp.error.9
86  (signals-type-error x '(setf . foo) (fboundp x))
87  t)
88
89(deftest fboundp.error.10
90  (loop for x in *mini-universe*
91        unless (symbolp x)
92        nconc
93        (handler-case
94         (list x (fboundp `(setf ,x)))
95         (type-error (c)
96                     (assert (not (typep (type-error-datum c)
97                                         (type-error-expected-type c))))
98                     nil)
99         (error (c) (list (list x c)))))
100  nil)
101
Note: See TracBrowser for help on using the repository browser.