← Back to branch summary

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

« back to all changes in this revision

Viewing changes to ansi-tests/subseq.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/subseq.lsp
 
1
;-*- Mode:     Lisp -*-
 
2
;;;; Author:   Paul Dietz
 
3
;;;; Created:  Sat Oct 12 19:41:14 2002
 
4
;;;; Contains: Tests on SUBSEQ
 
5
 
 
6
(in-package :cl-test)
 
7
 
 
8
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
9
;;; subseq, on lists
 
10
 
 
11
(deftest subseq-list.1
 
12
  (subseq '(a b c d e) 0 0)
 
13
  nil)
 
14
 
 
15
(deftest subseq-list.2
 
16
  (subseq '(a b c) 0)
 
17
  (a b c))
 
18
 
 
19
(deftest subseq-list.3
 
20
  (subseq '(a b c) 1)
 
21
  (b c))
 
22
 
 
23
 
 
24
(deftest subseq-list.4
 
25
  (subseq-list.4-body)
 
26
  t)
 
27
 
 
28
(deftest subseq-list.5
 
29
  (subseq-list.5-body)
 
30
  t)
 
31
 
 
32
(deftest subseq-list.6    ;; check that no structure is shared
 
33
  (subseq-list.6-body)
 
34
  t)
 
35
 
 
36
(deftest subseq-list.7
 
37
  (let ((x (loop for i from 0 to 9 collect i)))
 
38
    (setf (subseq x 0 3) (list 'a 'b 'c))
 
39
    x)
 
40
  (a b c 3 4 5 6 7 8 9))
 
41
 
 
42
(deftest subseq-list.8
 
43
  (let* ((x '(a b c d e))
 
44
         (y (copy-seq x)))
 
45
    (setf (subseq y 0) '(f g h))
 
46
    (list x y))
 
47
  ((a b c d e) (f g h d e)))
 
48
 
 
49
(deftest subseq-list.9
 
50
  (let* ((x '(a b c d e))
 
51
         (y (copy-seq x)))
 
52
    (setf (subseq y 1 3) '(1 2 3 4 5))
 
53
    (list x y))
 
54
  ((a b c d e) (a 1 2 d e)))
 
55
 
 
56
(deftest subseq-list.10
 
57
  (let* ((x '(a b c d e))
 
58
         (y (copy-seq x)))
 
59
    (setf (subseq y 5) '(1 2 3 4 5))
 
60
    (list x y))
 
61
  ((a b c d e) (a b c d e)))
 
62
 
 
63
(deftest subseq-list.11
 
64
  (let* ((x '(a b c d e))
 
65
         (y (copy-seq x)))
 
66
    (setf (subseq y 2 5) '(1))
 
67
    (list x y))
 
68
  ((a b c d e) (a b 1 d e)))
 
69
 
 
70
(deftest subseq-list.12
 
71
  (let* ((x '(a b c d e))
 
72
         (y (copy-seq x)))
 
73
    (setf (subseq y 0 0) '(1 2))
 
74
    (list x y))
 
75
  ((a b c d e) (a b c d e)))
 
76
 
 
77
;; subseq on vectors
 
78
 
 
79
 
 
80
(deftest subseq-vector.1
 
81
  (subseq-vector.1-body)
 
82
  t)
 
83
 
 
84
 
 
85
(deftest subseq-vector.2
 
86
    (subseq-vector.2-body)
 
87
  t) 
 
88
 
 
89
 
 
90
(deftest subseq-vector.3
 
91
    (subseq-vector.3-body)
 
92
  t) 
 
93
 
 
94
(deftest subseq-vector.4
 
95
    (subseq-vector.4-body)
 
96
  t) 
 
97
 
 
98
(deftest subseq-vector.5
 
99
  (subseq-vector.5-body)
 
100
  t) 
 
101
 
 
102
(deftest subseq-vector.6
 
103
  (subseq-vector.6-body)
 
104
  t)
 
105
 
 
106
(deftest subseq-vector.7
 
107
    (let* ((x (make-array '(10) :initial-contents '(a b c d e f g h i j)))
 
108
           (y (subseq x 2 8)))
 
109
      (equal-array y (make-array '(6) :initial-contents '(c d e f g h))))
 
110
  t)
 
111
 
 
112
(deftest subseq-vector.8
 
113
    (let* ((x (make-array '(200) :initial-element 107
 
114
                          :element-type 'fixnum))
 
115
           (y (subseq x 17 95)))
 
116
      (and (eqlt (length y) (- 95 17))
 
117
           (equal-array y
 
118
                        (make-array (list (- 95 17))
 
119
                                    :initial-element 107
 
120
                                    :element-type 'fixnum))))
 
121
  t)
 
122
 
 
123
(deftest subseq-vector.9
 
124
    (let* ((x (make-array '(1000) :initial-element 17.6e-1
 
125
                          :element-type 'single-float))
 
126
           (lo 164)
 
127
           (hi 873)
 
128
           (y (subseq x lo hi)))
 
129
      (and (eqlt (length y) (- hi lo))
 
130
           (equal-array y
 
131
                        (make-array (list (- hi lo))
 
132
                                    :initial-element 17.6e-1
 
133
                                    :element-type 'single-float))))
 
134
  t)
 
135
 
 
136
(deftest subseq-vector.10
 
137
    (let* ((x (make-array '(2000) :initial-element 3.1415927d4
 
138
                          :element-type 'double-float))
 
139
           (lo 731)
 
140
           (hi 1942)
 
141
           (y (subseq x lo hi)))
 
142
      (and (eqlt (length y) (- hi lo))
 
143
           (equal-array y
 
144
                        (make-array (list (- hi lo))
 
145
                                    :initial-element  3.1415927d4
 
146
                                    :element-type 'double-float))))
 
147
  t)
 
148
 
 
149
;;; subseq on strings
 
150
 
 
151
(deftest subseq-string.1
 
152
  (subseq-string.1-body)
 
153
  t)
 
154
 
 
155
(deftest subseq-string.2
 
156
  (subseq-string.2-body)
 
157
  t)
 
158
 
 
159
(deftest subseq-string.3
 
160
  (subseq-string.3-body)
 
161
  t)
 
162
 
 
163
;;; Tests on bit vectors
 
164
 
 
165
(deftest subseq-bit-vector.1
 
166
  (subseq-bit-vector.1-body)
 
167
  t)
 
168
 
 
169
(deftest subseq-bit-vector.2
 
170
  (subseq-bit-vector.2-body)
 
171
  t)
 
172
 
 
173
(deftest subseq-bit-vector.3
 
174
  (subseq-bit-vector.3-body)
 
175
  t)
 
176
 
 
177
;;; Order of evaluation
 
178
 
 
179
(deftest subseq.order.1
 
180
  (let ((i 0) a b c)
 
181
    (values
 
182
     (subseq
 
183
      (progn (setf a (incf i)) "abcdefgh")
 
184
      (progn (setf b (incf i)) 1)
 
185
      (progn (setf c (incf i)) 4))
 
186
     i a b c))
 
187
  "bcd" 3 1 2 3)
 
188
 
 
189
(deftest subseq.order.2
 
190
  (let ((i 0) a b)
 
191
    (values
 
192
     (subseq
 
193
      (progn (setf a (incf i)) "abcdefgh")
 
194
      (progn (setf b (incf i)) 1))
 
195
     i a b))
 
196
  "bcdefgh" 2 1 2)
 
197
 
 
198
(deftest subseq.order.3
 
199
  (let ((i 0) a b c d
 
200
        (s (copy-seq "abcdefgh")))
 
201
    (values
 
202
     (setf (subseq
 
203
            (progn (setf a (incf i)) s)
 
204
            (progn (setf b (incf i)) 1)
 
205
            (progn (setf c (incf i)) 4))
 
206
           (progn (setf d (incf i)) "xyz"))
 
207
     s i a b c d))
 
208
  "xyz" "axyzefgh" 4 1 2 3 4)
 
209
 
 
210
(deftest subseq.order.4
 
211
  (let ((i 0) a b c
 
212
        (s (copy-seq "abcd")))
 
213
    (values
 
214
     (setf (subseq
 
215
            (progn (setf a (incf i)) s)
 
216
            (progn (setf b (incf i)) 1))
 
217
           (progn (setf c (incf i)) "xyz"))
 
218
     s i a b c))
 
219
  "xyz" "axyz" 3 1 2 3)
 
220
 
 
221
;;; Error cases
 
222
 
 
223
(deftest subseq.error.1
 
224
  (signals-error (subseq) program-error)
 
225
  t)
 
226
 
 
227
(deftest subseq.error.2
 
228
  (signals-error (subseq nil) program-error)
 
229
  t)
 
230
 
 
231
(deftest subseq.error.3
 
232
  (signals-error (subseq nil 0 0 0) program-error)
 
233
  t)
 
234
 
 
235