slot-missing.lsp 2.11 KB
Newer Older
pfdietz's avatar
pfdietz committed
1 2 3 4 5 6 7
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sun Jun 15 06:03:58 2003
;;;; Contains: Tests of SLOT-MISSING

(in-package :cl-test)

pfdietz's avatar
pfdietz committed
8 9 10
(defparameter *slot-missing-class-01-var* nil)

(defclass slot-missing-class-01 () (a b c))
pfdietz's avatar
pfdietz committed
11 12

(defmethod slot-missing ((class t) (obj slot-missing-class-01)
sds's avatar
sds committed
13 14
                         (slot-name t) (operation t)
                         &optional (new-value nil new-value-p))
pfdietz's avatar
pfdietz committed
15
  (setf *slot-missing-class-01-var*
sds's avatar
sds committed
16
        (list slot-name operation new-value (notnot new-value-p))))
pfdietz's avatar
pfdietz committed
17 18 19

(deftest slot-missing.1
  (let ((obj (make-instance 'slot-missing-class-01)))
pfdietz's avatar
pfdietz committed
20 21 22 23
    (values
     (slot-value obj 'foo)
     *slot-missing-class-01-var*))
  (foo slot-value nil nil)
pfdietz's avatar
pfdietz committed
24 25 26 27
  (foo slot-value nil nil))

(deftest slot-missing.2
  (let ((obj (make-instance 'slot-missing-class-01)))
pfdietz's avatar
pfdietz committed
28 29 30 31
    (values
     (setf (slot-value obj 'foo) 'bar)
     *slot-missing-class-01-var*))
  bar
pfdietz's avatar
pfdietz committed
32 33 34 35
  (foo setf bar t))

(deftest slot-missing.3
  (let ((obj (make-instance 'slot-missing-class-01)))
pfdietz's avatar
pfdietz committed
36 37 38 39
    (values
     (eqt obj (slot-makunbound obj 'xyz))
     *slot-missing-class-01-var*))
  t
pfdietz's avatar
pfdietz committed
40 41 42 43
  (xyz slot-makunbound nil nil))

(deftest slot-missing.4
  (let ((obj (make-instance 'slot-missing-class-01)))
pfdietz's avatar
pfdietz committed
44 45 46 47
    (values
     (notnot (slot-boundp obj 'abc))
     *slot-missing-class-01-var*))
  t
pfdietz's avatar
pfdietz committed
48 49 50 51 52 53 54 55 56 57 58 59 60 61
  (abc slot-boundp nil nil))

(deftest slot-missing.5
  (let ((obj (make-instance 'slot-missing-class-01)))
    (slot-value obj 'd))
  (d slot-value nil nil))

(deftest slot-missing.6
  (let ((obj (make-instance 'slot-missing-class-01)))
    (setf (slot-value obj 'd) 'bar))
  bar)

(deftest slot-missing.7
  (let* ((obj (make-instance 'slot-missing-class-01))
sds's avatar
sds committed
62
         (val (slot-makunbound obj 'd)))
pfdietz's avatar
pfdietz committed
63
    (if (eq val obj)
sds's avatar
sds committed
64
        :good
pfdietz's avatar
pfdietz committed
65 66 67 68
      val))
  :good)

(defmethod slot-missing ((class t) (obj slot-missing-class-01)
sds's avatar
sds committed
69 70 71
                         (slot-name (eql 'not-there))
                         (operation (eql 'slot-boundp))
                         &optional new-value)
pfdietz's avatar
pfdietz committed
72 73 74 75 76 77 78
  (declare (ignore new-value))
  (values nil :ignore-this))

(deftest slot-missing.8
  (let* ((obj (make-instance 'slot-missing-class-01)))
    (slot-boundp obj 'not-there))
  nil)