← Back to branch summary

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

« back to all changes in this revision

Viewing changes to ansi-tests/structures-04.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/structures-04.lsp
 
1
;-*- Mode:     Lisp -*-
 
2
;;;; Author:   Paul Dietz
 
3
;;;; Created:  Mon May 19 20:07:40 2003
 
4
;;;; Contains: More tests of structures
 
5
 
 
6
(in-package :cl-test)
 
7
 
 
8
;;; I realized I had forgotten to test slot override in :include
 
9
;;; clauses in defstruct.
 
10
 
 
11
(defstruct struct-include-01a
 
12
  a (b 0))
 
13
 
 
14
(defstruct (struct-include-01b (:include struct-include-01a
 
15
                                         (a 100) (b 'x)))
 
16
  (c 200) d)
 
17
 
 
18
(deftest struct-include.1
 
19
  (let ((obj (make-struct-include-01b)))
 
20
    (values
 
21
     (typep* obj 'struct-include-01a)
 
22
     (typep* obj 'struct-include-01b)
 
23
     (struct-include-01a-a obj)
 
24
     (struct-include-01a-b obj)
 
25
     (struct-include-01b-a obj)
 
26
     (struct-include-01b-b obj)
 
27
     (struct-include-01b-c obj)))
 
28
  t t 100 x 100 x 200)
 
29
 
 
30
 
 
31
(deftest struct-include.2
 
32
  (let ((obj (make-struct-include-01b :a 1 :b 2 :c 3 :d 4)))
 
33
    (values
 
34
     (typep* obj 'struct-include-01a)
 
35
     (typep* obj 'struct-include-01b)
 
36
     (struct-include-01a-a obj)
 
37
     (struct-include-01a-b obj)
 
38
     (struct-include-01b-a obj)
 
39
     (struct-include-01b-b obj)
 
40
     (struct-include-01b-c obj)
 
41
     (struct-include-01b-d obj)
 
42
     ))
 
43
  t t 1 2 1 2 3 4)
 
44
 
 
45
(defstruct struct-include-02a
 
46
  (a 0 :type number))
 
47
 
 
48
(defstruct (struct-include-02b (:include struct-include-02a
 
49
                                         (a 10 :type integer))))
 
50
 
 
51
(deftest struct-include.3
 
52
  (let ((obj (make-struct-include-02b)))
 
53
    (values
 
54
     (typep* obj 'struct-include-02a)
 
55
     (typep* obj 'struct-include-02b)
 
56
     (struct-include-02a-a obj)
 
57
     (struct-include-02b-a obj)))
 
58
  t t 10 10)
 
59
 
 
60
(deftest struct-include.4
 
61
  (let ((obj (make-struct-include-02a)))
 
62
    (values
 
63
     (typep* obj 'struct-include-02a)
 
64
     (typep* obj 'struct-include-02b)
 
65
     (struct-include-02a-a obj)))
 
66
  t nil 0)
 
67
 
 
68
(deftest struct-include.5
 
69
  (let ((obj (make-struct-include-02b :a 100)))
 
70
    (values
 
71
     (typep* obj 'struct-include-02a)
 
72
     (typep* obj 'struct-include-02b)
 
73
     (struct-include-02a-a obj)
 
74
     (struct-include-02b-a obj)))
 
75
  t t 100 100)
 
76
 
 
77
(defstruct struct-include-03a
 
78
  (a 0 :type number))
 
79
 
 
80
(defstruct (struct-include-03b (:include struct-include-03a (a))))
 
81
 
 
82
(deftest struct-include.5a
 
83
  (let ((obj (make-struct-include-03b :a 100)))
 
84
    (values
 
85
     (typep* obj 'struct-include-03a)
 
86
     (typep* obj 'struct-include-03b)
 
87
     (struct-include-03a-a obj)
 
88
     (struct-include-03b-a obj)))
 
89
  t t 100 100)
 
90
 
 
91
(defstruct struct-include-04a a b)
 
92
 
 
93
(defstruct (struct-include-04b (:include struct-include-04a
 
94
                                         (a 0 :read-only t))))
 
95
 
 
96
(deftest struct-include.6
 
97
  (let ((obj (make-struct-include-04b)))
 
98
    (values
 
99
     (typep* obj 'struct-include-04a)
 
100
     (typep* obj 'struct-include-04b)
 
101
     (struct-include-04a-a obj)
 
102
     (struct-include-04b-a obj)))
 
103
  t t 0 0)
 
104
 
 
105
(deftest struct-include.7
 
106
  (let ((obj (make-struct-include-04b :a 1 :b 2)))
 
107
    (values
 
108
     (typep* obj 'struct-include-04a)
 
109
     (typep* obj 'struct-include-04b)
 
110
     (struct-include-04a-a obj)
 
111
     (struct-include-04b-a obj)
 
112
     (struct-include-04a-b obj)
 
113
     (struct-include-04b-b obj)))
 
114
  t t 1 1 2 2)