source: trunk/source/tests/ansi-tests/slot-missing.lsp @ 8991

Last change on this file since 8991 was 8991, checked in by gz, 11 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:  Sun Jun 15 06:03:58 2003
4;;;; Contains: Tests of SLOT-MISSING
5
6(in-package :cl-test)
7
8(defparameter *slot-missing-class-01-var* nil)
9
10(defclass slot-missing-class-01 () (a b c))
11
12(defmethod slot-missing ((class t) (obj slot-missing-class-01)
13                         (slot-name t) (operation t)
14                         &optional (new-value nil new-value-p))
15  (setf *slot-missing-class-01-var*
16        (list slot-name operation new-value (notnot new-value-p))))
17
18(deftest slot-missing.1
19  (let ((obj (make-instance 'slot-missing-class-01)))
20    (values
21     (slot-value obj 'foo)
22     *slot-missing-class-01-var*))
23  (foo slot-value nil nil)
24  (foo slot-value nil nil))
25
26(deftest slot-missing.2
27  (let ((obj (make-instance 'slot-missing-class-01)))
28    (values
29     (setf (slot-value obj 'foo) 'bar)
30     *slot-missing-class-01-var*))
31  bar
32  (foo setf bar t))
33
34(deftest slot-missing.3
35  (let ((obj (make-instance 'slot-missing-class-01)))
36    (values
37     (eqt obj (slot-makunbound obj 'xyz))
38     *slot-missing-class-01-var*))
39  t
40  (xyz slot-makunbound nil nil))
41
42(deftest slot-missing.4
43  (let ((obj (make-instance 'slot-missing-class-01)))
44    (values
45     (notnot (slot-boundp obj 'abc))
46     *slot-missing-class-01-var*))
47  t
48  (abc slot-boundp nil nil))
49
50(deftest slot-missing.5
51  (let ((obj (make-instance 'slot-missing-class-01)))
52    (slot-value obj 'd))
53  (d slot-value nil nil))
54
55(deftest slot-missing.6
56  (let ((obj (make-instance 'slot-missing-class-01)))
57    (setf (slot-value obj 'd) 'bar))
58  bar)
59
60(deftest slot-missing.7
61  (let* ((obj (make-instance 'slot-missing-class-01))
62         (val (slot-makunbound obj 'd)))
63    (if (eq val obj)
64        :good
65      val))
66  :good)
67
68(defmethod slot-missing ((class t) (obj slot-missing-class-01)
69                         (slot-name (eql 'not-there))
70                         (operation (eql 'slot-boundp))
71                         &optional new-value)
72  (declare (ignore new-value))
73  (values nil :ignore-this))
74
75(deftest slot-missing.8
76  (let* ((obj (make-instance 'slot-missing-class-01)))
77    (slot-boundp obj 'not-there))
78  nil)
Note: See TracBrowser for help on using the repository browser.