fmakunbound.lsp 2.12 KB
Newer Older
1 2 3 4 5 6 7 8 9 10
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Tue Oct  8 00:09:14 2002
;;;; Contains: Tests for FMAKUNBOUND

(in-package :cl-test)

(deftest fmakunbound.1
  (let ((g (gensym)))
    (and (not (fboundp g))
sds's avatar
sds committed
11 12 13 14
         (setf (symbol-function g) #'car)
         (fboundp g)
         (values (eqt (check-values (fmakunbound g)) g)
                 (fboundp g))))
15 16 17 18 19
  t nil)

(deftest fmakunbound.2
  (let ((g (gensym)))
    (and (not (fboundp g))
sds's avatar
sds committed
20 21 22 23
         (eval `(defun ,g () nil))
         (fboundp g)
         (values (eqt (check-values (fmakunbound g)) g)
                 (fboundp g))))
24 25 26 27 28
  t nil)

(deftest fmakunbound.3
  (let ((g (gensym)))
    (and (not (fboundp g))
sds's avatar
sds committed
29 30 31 32
         (eval `(defmacro ,g () nil))
         (fboundp g)
         (values (eqt (check-values (fmakunbound g)) g)
                 (fboundp g))))
33 34 35 36
  t nil)

(deftest fmakunbound.4
  (let* ((g (gensym))
sds's avatar
sds committed
37
         (n `(setf ,g)))
38
    (and (not (fboundp n))
sds's avatar
sds committed
39 40 41 42
         (eval `(defun ,n () nil))
         (fboundp n)
         (values (equalt (check-values (fmakunbound n)) n)
                 (fboundp n))))
43 44
  t nil)

45
(deftest fmakunbound.error.1
46
  (check-type-error #'fmakunbound
sds's avatar
sds committed
47
                    #'(lambda (x) (typep x '(or symbol (cons (eql setf) (cons symbol null))))))
pfdietz's avatar
pfdietz committed
48
  nil)
49

50
(deftest fmakunbound.error.2
51
  (check-type-error #'fmakunbound (constantly nil)
sds's avatar
sds committed
52
                    '((setf) (setf . foo) (setf foo . bar) (setf foo bar)))
53
  nil)
54

55
(deftest fmakunbound.error.3
56
  (signals-type-error x '(x) (fmakunbound x))
57
  t)
58

59
(deftest fmakunbound.error.4
60 61
  (signals-error (fmakunbound) program-error)
  t)
62 63

(deftest fmakunbound.error.5
64 65
  (signals-error (fmakunbound (gensym) nil) program-error)
  t)
66

67
(deftest fmakunbound.error.6
68 69 70
  (signals-error (locally (fmakunbound 1) t) type-error)
  t)

71
(deftest fmakunbound.error.7
72
  (loop for x in *mini-universe*
sds's avatar
sds committed
73 74 75 76 77 78 79 80 81 82
        unless (symbolp x)
        nconc
        (handler-case
         (list x (fmakunbound `(setf ,x)))
         (type-error (c)
                     (assert (not (typep (type-error-datum c)
                                         (type-error-expected-type c))))
                     nil)
         (error (c) (list (list x c)))))
  nil)