source: trunk/source/tests/ansi-tests/slot-makunbound.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.2 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sat May 10 14:39:01 2003
4;;;; Contains: Tests for SLOT-MAKUNBOUND
5
6(in-package :cl-test)
7
8;;; This function is heavily tested in other files as well
9
10(defclass slot-makunbound-class-01 ()
11  (a
12   (b :allocation :instance)
13   (c :allocation :class)
14   (d :type fixnum)
15   (e :type t)
16   (f :type cons)))
17
18(deftest slot-makunbound.1
19  (loop for slot-name in '(a b c d e)
20        unless
21        (let ((obj (allocate-instance (find-class 'slot-makunbound-class-01))))
22          (and
23           (equalt (multiple-value-list (slot-makunbound obj slot-name))
24                   (list obj))
25           (not (slot-boundp obj slot-name))))
26        collect slot-name)
27  nil)
28
29(deftest slot-makunbound.2
30  (loop for slot-name in '(a b c d e)
31        for slot-value in '(t t t 10 t '(a))
32        unless
33        (let ((obj (allocate-instance (find-class 'slot-makunbound-class-01))))
34          (setf (slot-value obj slot-name) slot-value)
35          (and
36           (equalt (multiple-value-list (slot-makunbound obj slot-name))
37                   (list obj))
38           (not (slot-boundp obj slot-name))))
39        collect slot-name)
40  nil)
41
42;;; Order of evaluation test(s)
43
44(deftest slot-makunbound.order.1
45  (let ((obj (make-instance 'slot-makunbound-class-01))
46        (i 0) x y)
47    (values
48     (eqt (slot-makunbound (progn (setf x (incf i)) obj)
49                           (progn (setf y (incf i)) 'a))
50          obj)
51     i x y))
52  t 2 1 2)
53
54(deftest slot-makunbound.order.2
55  (let ((obj (make-instance 'slot-makunbound-class-01))
56        (i 0) x y)
57    (setf (slot-value obj 'a) t)
58    (values
59     (eqt (slot-makunbound (progn (setf x (incf i)) obj)
60                           (progn (setf y (incf i)) 'a))
61          obj)
62     i x y))
63  t 2 1 2)
64
65;;; Error cases
66
67(deftest slot-makunbound.error.1
68  (signals-error (slot-makunbound) program-error)
69  t)
70
71(deftest slot-makunbound.error.2
72  (signals-error (slot-makunbound (make-instance 'slot-makunbound-class-01))
73                 program-error)
74  t)
75
76(deftest slot-makunbound.error.3
77  (signals-error (slot-makunbound (make-instance 'slot-makunbound-class-01)
78                                   'a nil)
79                 program-error)
80  t)
81
82(deftest slot-makunbound.error.4
83  (let ((built-in-class (find-class 'built-in-class)))
84    (loop for e in *mini-universe*
85          for class = (class-of e)
86          when (and (eq (class-of class) built-in-class)
87                    (handler-case (progn (slot-makunbound e 'foo) t)
88                                  (error () nil)))
89          collect e))
90  nil)
91
Note: See TracBrowser for help on using the repository browser.