← Back to branch summary

~ubuntu-branches/ubuntu/quantal/gclcvs/quantal

« back to all changes in this revision

Viewing changes to ansi-tests/slot-boundp.lsp

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2004-06-24 15:13:46 UTC
  • Revision ID: james.westby@ubuntu.com-20040624151346-xh0xaaktyyp7aorc
Tags: 2.7.0-26
C_GC_OFFSET is 2 on m68k-linux

Show diffs side-by-side

added added

removed removed

Lines of Context:
ansi-tests/slot-boundp.lsp
 
1
;-*- Mode:     Lisp -*-
 
2
;;;; Author:   Paul Dietz
 
3
;;;; Created:  Tue May  6 05:53:32 2003
 
4
;;;; Contains: Tests of SLOT-BOUNDP
 
5
 
 
6
(in-package :cl-test)
 
7
 
 
8
;;; SLOT-BOUNDP is extensively tested in other files as well
 
9
 
 
10
(defclass slot-boundp-class-01 ()
 
11
  (a (b :initarg :b) (c :initform 'x)))
 
12
 
 
13
(deftest slot-boundp.1
 
14
  (let ((obj (make-instance 'slot-boundp-class-01)))
 
15
    (slot-boundp obj 'a))
 
16
  nil)
 
17
 
 
18
(deftest slot-boundp.2
 
19
  (let ((obj (make-instance 'slot-boundp-class-01)))
 
20
    (setf (slot-value obj 'a) nil)
 
21
    (notnot-mv (slot-boundp obj 'a)))
 
22
  t)
 
23
 
 
24
(deftest slot-boundp.3
 
25
  (let ((obj (make-instance 'slot-boundp-class-01 :b nil)))
 
26
    (notnot-mv (slot-boundp obj 'b)))
 
27
  t)
 
28
 
 
29
(deftest slot-boundp.4
 
30
  (let ((obj (make-instance 'slot-boundp-class-01)))
 
31
    (notnot-mv (slot-boundp obj 'c)))
 
32
  t)
 
33
 
 
34
(deftest slot-boundp.5
 
35
  (let ((obj (make-instance 'slot-boundp-class-01)))
 
36
    (slot-makunbound obj 'c)
 
37
    (slot-boundp obj 'c))
 
38
  nil)
 
39
 
 
40
;;; Argument order test(s)
 
41
 
 
42
(deftest slot-boundp.order.1
 
43
  (let ((obj (make-instance 'slot-boundp-class-01))
 
44
        (i 0) x y)
 
45
    (values
 
46
     (slot-boundp (progn (setf x (incf i)) obj)
 
47
                  (progn (setf y (incf i)) 'a))
 
48
     i x y))
 
49
  nil 2 1 2)
 
50
 
 
51
;;; Error tests
 
52
 
 
53
(deftest slot-boundp.error.1
 
54
  (signals-error (slot-boundp) program-error)
 
55
  t)
 
56
 
 
57
(deftest slot-boundp.error.2
 
58
  (signals-error (let ((obj (make-instance 'slot-boundp-class-01)))
 
59
                    (slot-boundp obj))
 
60
                 program-error)
 
61
  t)
 
62
 
 
63
(deftest slot-boundp.error.3
 
64
  (signals-error (let ((obj (make-instance 'slot-boundp-class-01)))
 
65
                    (slot-boundp obj 'a nil))
 
66
                 program-error)
 
67
  t)
 
68
 
 
69
(deftest slot-boundp.error.4
 
70
  (signals-error
 
71
   (let ((obj (make-instance 'slot-boundp-class-01)))
 
72
     (slot-boundp obj 'nonexistent-slot))
 
73
   error)
 
74
  t)
 
75
 
 
76
;;; SLOT-BOUNDP should signal an error on elements of built-in-classes
 
77
(deftest slot-boundp.error.5
 
78
  (let ((built-in-class (find-class 'built-in-class)))
 
79
    (loop for e in *mini-universe*
 
80
          for class = (class-of e)
 
81
          when (and (eq (class-of class) built-in-class)
 
82
                    (handler-case (progn (slot-boundp e 'foo) t)
 
83
                                  (error () nil)))
 
84
          collect e))
 
85
  nil)