subseq.lsp 7.57 KB
Newer Older
1 2 3 4 5 6 7
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sat Oct 12 19:41:14 2002
;;;; Contains: Tests on SUBSEQ

(in-package :cl-test)

8

9

10 11 12
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; subseq, on lists

13
(deftest subseq-list.1
14 15 16
  (subseq '(a b c d e) 0 0)
  nil)

17
(deftest subseq-list.2
18 19 20
  (subseq '(a b c) 0)
  (a b c))

21
(deftest subseq-list.3
22 23 24 25
  (subseq '(a b c) 1)
  (b c))


26 27
(deftest subseq-list.4
  (subseq-list.4-body)
28 29
  t)

30 31
(deftest subseq-list.5
  (subseq-list.5-body)
32 33
  t)

34 35
(deftest subseq-list.6    ;; check that no structure is shared
  (subseq-list.6-body)
36 37
  t)

38
(deftest subseq-list.7
39 40 41 42 43
  (let ((x (loop for i from 0 to 9 collect i)))
    (setf (subseq x 0 3) (list 'a 'b 'c))
    x)
  (a b c 3 4 5 6 7 8 9))

44
(deftest subseq-list.8
45
  (let* ((x '(a b c d e))
sds's avatar
sds committed
46
         (y (copy-seq x)))
47 48 49 50
    (setf (subseq y 0) '(f g h))
    (list x y))
  ((a b c d e) (f g h d e)))

51
(deftest subseq-list.9
52
  (let* ((x '(a b c d e))
sds's avatar
sds committed
53
         (y (copy-seq x)))
54 55 56 57
    (setf (subseq y 1 3) '(1 2 3 4 5))
    (list x y))
  ((a b c d e) (a 1 2 d e)))

58
(deftest subseq-list.10
59
  (let* ((x '(a b c d e))
sds's avatar
sds committed
60
         (y (copy-seq x)))
61 62 63 64
    (setf (subseq y 5) '(1 2 3 4 5))
    (list x y))
  ((a b c d e) (a b c d e)))

65
(deftest subseq-list.11
66
  (let* ((x '(a b c d e))
sds's avatar
sds committed
67
         (y (copy-seq x)))
68 69 70 71
    (setf (subseq y 2 5) '(1))
    (list x y))
  ((a b c d e) (a b 1 d e)))

72
(deftest subseq-list.12
73
  (let* ((x '(a b c d e))
sds's avatar
sds committed
74
         (y (copy-seq x)))
75 76 77 78 79 80 81
    (setf (subseq y 0 0) '(1 2))
    (list x y))
  ((a b c d e) (a b c d e)))

;; subseq on vectors


82 83
(deftest subseq-vector.1
  (subseq-vector.1-body)
84
  t)
85 86


87 88
(deftest subseq-vector.2
    (subseq-vector.2-body)
sds's avatar
sds committed
89
  t)
90 91


92 93
(deftest subseq-vector.3
    (subseq-vector.3-body)
sds's avatar
sds committed
94
  t)
95

96 97
(deftest subseq-vector.4
    (subseq-vector.4-body)
sds's avatar
sds committed
98
  t)
99

100 101
(deftest subseq-vector.5
  (subseq-vector.5-body)
sds's avatar
sds committed
102
  t)
103

104 105
(deftest subseq-vector.6
  (subseq-vector.6-body)
106 107
  t)

108
(deftest subseq-vector.7
109
    (let* ((x (make-array '(10) :initial-contents '(a b c d e f g h i j)))
sds's avatar
sds committed
110
           (y (subseq x 2 8)))
111 112 113
      (equal-array y (make-array '(6) :initial-contents '(c d e f g h))))
  t)

114
(deftest subseq-vector.8
115
    (let* ((x (make-array '(200) :initial-element 107
sds's avatar
sds committed
116 117
                          :element-type 'fixnum))
           (y (subseq x 17 95)))
118
      (and (eqlt (length y) (- 95 17))
sds's avatar
sds committed
119 120 121 122
           (equal-array y
                        (make-array (list (- 95 17))
                                    :initial-element 107
                                    :element-type 'fixnum))))
123 124
  t)

125
(deftest subseq-vector.9
126
    (let* ((x (make-array '(1000) :initial-element 17.6e-1
sds's avatar
sds committed
127 128 129 130
                          :element-type 'single-float))
           (lo 164)
           (hi 873)
           (y (subseq x lo hi)))
131
      (and (eqlt (length y) (- hi lo))
sds's avatar
sds committed
132 133 134 135
           (equal-array y
                        (make-array (list (- hi lo))
                                    :initial-element 17.6e-1
                                    :element-type 'single-float))))
136 137
  t)

138
(deftest subseq-vector.10
139
    (let* ((x (make-array '(2000) :initial-element 3.1415927d4
sds's avatar
sds committed
140 141 142 143
                          :element-type 'double-float))
           (lo 731)
           (hi 1942)
           (y (subseq x lo hi)))
144
      (and (eqlt (length y) (- hi lo))
sds's avatar
sds committed
145 146 147 148
           (equal-array y
                        (make-array (list (- hi lo))
                                    :initial-element  3.1415927d4
                                    :element-type 'double-float))))
149 150
  t)

151 152
;;; subseq on strings

153 154
(deftest subseq-string.1
  (subseq-string.1-body)
155 156
  t)

157 158
(deftest subseq-string.2
  (subseq-string.2-body)
159 160
  t)

161 162
(deftest subseq-string.3
  (subseq-string.3-body)
163 164
  t)

165 166 167 168
;;; Specialized string tests

(deftest subseq.specialized-string.1
  (let* ((s0 "abcde")
sds's avatar
sds committed
169
         (len (length s0)))
170 171 172
    (do-special-strings
     (s "abcde" nil)
     (loop for i from 0 below len
sds's avatar
sds committed
173 174 175 176 177 178 179
           for s1 = (subseq s i)
           do (assert (typep s1 'simple-array))
           do (assert (string= (subseq s i) (subseq s0 i)))
           do (loop for j from i to len
                    for s2 = (subseq s i j)
                    do (assert (typep s2 'simple-array))
                    (assert (string= s2 (subseq s0 i j)))))))
180 181
  nil)

182 183 184 185
;;; Other specialized vectors

(deftest subseq.specialized-vector.1
  (let* ((v0 #(1 0 1 1 0 1 1 0))
sds's avatar
sds committed
186
         (len (length v0)))
187 188 189
    (do-special-integer-vectors
     (v (copy-seq v0) nil)
     (loop for i from 0 below len
sds's avatar
sds committed
190 191 192 193 194 195 196
           for v1 = (subseq v i)
           do (assert (typep v1 'simple-array))
           do (assert (equalp (subseq v i) (subseq v0 i)))
           do (loop for j from i to len
                    for v2 = (subseq v i j)
                    do (assert (typep v2 'simple-array))
                    (assert (equalp v2 (subseq v0 i j)))))))
197 198 199 200
  nil)

(deftest subseq.specialized-vector.2
  (loop for type in '(short-float single-float long-float double-float)
sds's avatar
sds committed
201 202 203 204 205 206 207 208
        for len = 10
        for vals = (loop for i from 1 to len collect (coerce i type))
        for vec = (make-array len :element-type type :initial-contents vals)
        for result = (subseq vec 1 9)
        unless (and (= (length result) 8)
                    (equal (array-element-type vec) (array-element-type result))
                    (equalp result (apply #'vector (subseq vals 1 9))))
        collect (list type vals result))
209 210 211 212
  nil)

(deftest subseq.specialized-vector.3
  (loop for etype in '(short-float single-float long-float double-float
sds's avatar
sds committed
213 214 215 216 217 218 219 220 221 222 223
                                   integer rational)
        for type = `(complex ,etype)
        for len = 10
        for vals = (loop for i from 1 to len collect (complex (coerce i etype)
                                                              (coerce (- i) etype)))
        for vec = (make-array len :element-type type :initial-contents vals)
        for result = (subseq vec 1 9)
        unless (and (= (length result) 8)
                    (equal (array-element-type vec) (array-element-type result))
                    (equalp result (apply #'vector (subseq vals 1 9))))
        collect (list type vals result))
224 225
  nil)

226 227
;;; Tests on bit vectors

228 229
(deftest subseq-bit-vector.1
  (subseq-bit-vector.1-body)
230 231
  t)

232 233
(deftest subseq-bit-vector.2
  (subseq-bit-vector.2-body)
234 235
  t)

236 237
(deftest subseq-bit-vector.3
  (subseq-bit-vector.3-body)
238
  t)
239

240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262
;;; Order of evaluation

(deftest subseq.order.1
  (let ((i 0) a b c)
    (values
     (subseq
      (progn (setf a (incf i)) "abcdefgh")
      (progn (setf b (incf i)) 1)
      (progn (setf c (incf i)) 4))
     i a b c))
  "bcd" 3 1 2 3)

(deftest subseq.order.2
  (let ((i 0) a b)
    (values
     (subseq
      (progn (setf a (incf i)) "abcdefgh")
      (progn (setf b (incf i)) 1))
     i a b))
  "bcdefgh" 2 1 2)

(deftest subseq.order.3
  (let ((i 0) a b c d
sds's avatar
sds committed
263
        (s (copy-seq "abcdefgh")))
264 265
    (values
     (setf (subseq
sds's avatar
sds committed
266 267 268 269
            (progn (setf a (incf i)) s)
            (progn (setf b (incf i)) 1)
            (progn (setf c (incf i)) 4))
           (progn (setf d (incf i)) "xyz"))
270 271 272 273 274
     s i a b c d))
  "xyz" "axyzefgh" 4 1 2 3 4)

(deftest subseq.order.4
  (let ((i 0) a b c
sds's avatar
sds committed
275
        (s (copy-seq "abcd")))
276 277
    (values
     (setf (subseq
sds's avatar
sds committed
278 279 280
            (progn (setf a (incf i)) s)
            (progn (setf b (incf i)) 1))
           (progn (setf c (incf i)) "xyz"))
281 282 283
     s i a b c))
  "xyz" "axyz" 3 1 2 3)

284 285
;;; Constant folding

286 287 288 289
(def-fold-test subseq.fold.1 (subseq '(1 2 3) 0))
(def-fold-test subseq.fold.2 (subseq #(1 2 3) 0))
(def-fold-test subseq.fold.3 (subseq #*011101 0))
(def-fold-test subseq.fold.4 (subseq "abcdef" 0))
290

291 292 293
;;; Error cases

(deftest subseq.error.1
294 295
  (signals-error (subseq) program-error)
  t)
296 297

(deftest subseq.error.2
298 299
  (signals-error (subseq nil) program-error)
  t)
300 301

(deftest subseq.error.3
302 303
  (signals-error (subseq nil 0 0 0) program-error)
  t)
304 305