slot-boundp.lsp 2.19 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Tue May  6 05:53:32 2003
;;;; Contains: Tests of SLOT-BOUNDP

(in-package :cl-test)

;;; SLOT-BOUNDP is extensively tested in other files as well

(defclass slot-boundp-class-01 ()
  (a (b :initarg :b) (c :initform 'x)))

(deftest slot-boundp.1
  (let ((obj (make-instance 'slot-boundp-class-01)))
    (slot-boundp obj 'a))
  nil)

(deftest slot-boundp.2
  (let ((obj (make-instance 'slot-boundp-class-01)))
    (setf (slot-value obj 'a) nil)
    (notnot-mv (slot-boundp obj 'a)))
  t)

(deftest slot-boundp.3
  (let ((obj (make-instance 'slot-boundp-class-01 :b nil)))
    (notnot-mv (slot-boundp obj 'b)))
  t)

(deftest slot-boundp.4
  (let ((obj (make-instance 'slot-boundp-class-01)))
    (notnot-mv (slot-boundp obj 'c)))
  t)

(deftest slot-boundp.5
  (let ((obj (make-instance 'slot-boundp-class-01)))
    (slot-makunbound obj 'c)
    (slot-boundp obj 'c))
  nil)

40 41 42 43
;;; Argument order test(s)

(deftest slot-boundp.order.1
  (let ((obj (make-instance 'slot-boundp-class-01))
sds's avatar
sds committed
44
        (i 0) x y)
45 46
    (values
     (slot-boundp (progn (setf x (incf i)) obj)
sds's avatar
sds committed
47
                  (progn (setf y (incf i)) 'a))
48 49 50
     i x y))
  nil 2 1 2)

51 52 53
;;; Error tests

(deftest slot-boundp.error.1
54 55
  (signals-error (slot-boundp) program-error)
  t)
56 57

(deftest slot-boundp.error.2
58
  (signals-error (let ((obj (make-instance 'slot-boundp-class-01)))
sds's avatar
sds committed
59 60
                    (slot-boundp obj))
                 program-error)
61
  t)
62 63

(deftest slot-boundp.error.3
64
  (signals-error (let ((obj (make-instance 'slot-boundp-class-01)))
sds's avatar
sds committed
65 66
                    (slot-boundp obj 'a nil))
                 program-error)
67
  t)
68 69

(deftest slot-boundp.error.4
70 71 72 73
  (signals-error
   (let ((obj (make-instance 'slot-boundp-class-01)))
     (slot-boundp obj 'nonexistent-slot))
   error)
74 75 76 77 78 79
  t)

;;; SLOT-BOUNDP should signal an error on elements of built-in-classes
(deftest slot-boundp.error.5
  (let ((built-in-class (find-class 'built-in-class)))
    (loop for e in *mini-universe*
sds's avatar
sds committed
80 81 82 83 84
          for class = (class-of e)
          when (and (eq (class-of class) built-in-class)
                    (handler-case (progn (slot-boundp e 'foo) t)
                                  (error () nil)))
          collect e))
85
  nil)