copy-seq.lsp 6.79 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sat Nov  2 21:38:08 2002
;;;; Contains: Tests for COPY-SEQ

(in-package :cl-test)

;;; This function is extensively used elsewhere, but is tested again
;;; here for completeness.

(deftest copy-seq.1
  (copy-seq nil)
  nil)

(deftest copy-seq.2
  (let* ((s1 '(a b c))
sds's avatar
sds committed
17
         (s2 (check-values (copy-seq s1))))
18
    (and (not (eql s1 s2))
sds's avatar
sds committed
19
         (equalt s1 s2)))
20 21 22 23
  t)

(deftest copy-seq.3
  (let* ((s1 #(a b c))
sds's avatar
sds committed
24
         (s2 (check-values (copy-seq s1))))
25 26 27 28 29
    (and (not (eql s1 s2)) s2))
  #(a b c))

(deftest copy-seq.4
  (let* ((s1 (make-array '(4) :initial-contents '(a b c d)
sds's avatar
sds committed
30 31
                         :adjustable t))
         (s2 (check-values (copy-seq s1))))
32
    (and (not (eql s1 s2))
sds's avatar
sds committed
33 34
         (simple-vector-p s2)
         s2))
35 36 37 38 39
  #(a b c d))


(deftest copy-seq.5
  (let* ((s1 (make-array '(4) :initial-contents '(a b c d)
sds's avatar
sds committed
40 41
                         :fill-pointer 3))
         (s2 (check-values (copy-seq s1))))
42
    (and (not (eql s1 s2))
sds's avatar
sds committed
43 44
         (simple-vector-p s2)
         s2))
45 46 47 48
  #(a b c))

(deftest copy-seq.6
  (let* ((a1 (make-array '(6) :initial-contents '(a b c d e f)))
sds's avatar
sds committed
49 50 51
         (a2 (make-array '(4) :displaced-to a1
                         :displaced-index-offset 1))
         (s2 (check-values (copy-seq a2))))
52
    (and (not (eql a2 s2))
sds's avatar
sds committed
53 54
         (simple-vector-p s2)
         s2))
55 56 57 58
  #(b c d e))

(deftest copy-seq.7
  (let* ((s1 (make-array '(4)
sds's avatar
sds committed
59 60 61 62
                         :element-type 'base-char
                         :initial-contents '(#\a #\b #\c #\d)
                         :adjustable t))
         (s2 (check-values (copy-seq s1))))
63
    (and (not (eql s1 s2))
sds's avatar
sds committed
64 65
         (simple-string-p s2)
         s2))
66 67 68 69 70
  "abcd")


(deftest copy-seq.8
  (let* ((s1 (make-array '(4)
sds's avatar
sds committed
71 72 73 74
                         :element-type 'base-char
                         :initial-contents '(#\a #\b #\c #\d)
                         :fill-pointer 3))
         (s2 (check-values (copy-seq s1))))
75
    (and (not (eql s1 s2))
sds's avatar
sds committed
76 77
         (simple-string-p s2)
         s2))
78 79 80 81
  "abc")

(deftest copy-seq.9
  (let* ((a1 (make-array '(6) :initial-contents '(#\a #\b #\c #\d #\e #\f)
sds's avatar
sds committed
82 83 84 85 86
                         :element-type 'base-char))
         (a2 (make-array '(4) :displaced-to a1
                         :element-type 'base-char
                         :displaced-index-offset 1))
         (s2 (check-values (copy-seq a2))))
87
    (and (not (eql a2 s2))
sds's avatar
sds committed
88 89
         (simple-string-p s2)
         s2))
90 91 92 93
  "bcde")

(deftest copy-seq.10
  (let*((s1 "abcd")
sds's avatar
sds committed
94
        (s2 (check-values (copy-seq s1))))
95
    (and (not (eql s1 s2))
sds's avatar
sds committed
96
         s2))
97 98 99 100
  "abcd")

(deftest copy-seq.11
  (let* ((s1 #*0010110)
sds's avatar
sds committed
101
         (s2 (check-values (copy-seq s1))))
102
    (and (not (eql s1 s2))
sds's avatar
sds committed
103 104
         (simple-bit-vector-p s2)
         s2))
105 106 107 108
  #*0010110)

(deftest copy-seq.12
  (let* ((s1 (make-array '(4) :initial-contents '(0 0 1 0)
sds's avatar
sds committed
109 110 111
                         :element-type 'bit
                         :adjustable t))
         (s2 (check-values (copy-seq s1))))
112
    (and (not (eql s1 s2))
sds's avatar
sds committed
113 114
         (simple-bit-vector-p s2)
         s2))
115 116 117 118
  #*0010)

(deftest copy-seq.13
  (let* ((s1 (make-array '(4) :initial-contents '(0 0 1 0)
sds's avatar
sds committed
119 120 121
                         :element-type 'bit
                         :fill-pointer 3))
         (s2 (check-values (copy-seq s1))))
122
    (and (not (eql s1 s2))
sds's avatar
sds committed
123 124
         (simple-bit-vector-p s2)
         s2))
125 126 127 128
  #*001)

(deftest copy-seq.14
  (let* ((a1 (make-array '(6) :initial-contents '(0 0 1 0 1 1)
sds's avatar
sds committed
129 130 131 132 133
                         :element-type 'bit))
         (a2 (make-array '(4) :displaced-to a1
                         :displaced-index-offset 1
                         :element-type 'bit))
         (s2 (check-values (copy-seq a2))))
134
    (and (not (eql a2 s2))
sds's avatar
sds committed
135 136
         (simple-bit-vector-p s2)
         s2))
137 138 139 140 141 142 143 144 145 146 147 148 149 150
  #*0101)

(deftest copy-seq.15
  (copy-seq "")
  "")

(deftest copy-seq.16
  (copy-seq #*)
  #*)

(deftest copy-seq.17
  (copy-seq #())
  #())

151 152
(deftest copy-seq.18
  (let* ((x (make-array '(10) :initial-contents '(a b c d e f g h i j)))
sds's avatar
sds committed
153
         (y (check-values (copy-seq x))))
154 155 156
    (equal-array x y))
  t)

157
(deftest copy-seq.19
158
  :notes (:nil-vectors-are-strings)
159 160 161
  (copy-seq (make-array '(0) :element-type nil))
  "")

162 163 164 165 166 167 168 169 170 171 172
;;; Specialized string tests

(deftest copy-seq.20
  (do-special-strings
   (s "abcde" nil)
   (let ((s2 (copy-seq s)))
     (assert (typep s2 'simple-array))
     (assert (string= s s2))
     (assert (equal (array-element-type s) (array-element-type s2)))))
  nil)

173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198
;;; Specialized vector tests

(deftest copy-seq.21
  (let ((v0 #(1 1 0 1 1 2)))
    (do-special-integer-vectors
     (v v0 nil)
     (let ((v2 (copy-seq v)))
       (assert (typep v2 'simple-array))
       (assert (equalp v v2))
       (assert (equalp v v0))
       (assert (equal (array-element-type v) (array-element-type v2))))))
  nil)

(deftest copy-seq.22
  (let ((v0 #(-1 1 1 0 1 -1 0)))
    (do-special-integer-vectors
     (v v0 nil)
     (let ((v2 (copy-seq v)))
       (assert (typep v2 'simple-array))
       (assert (equalp v v2))
       (assert (equalp v v0))
       (assert (equal (array-element-type v) (array-element-type v2))))))
  nil)

(deftest copy-seq.23
  (loop for type in '(short-float single-float long-float double-float)
sds's avatar
sds committed
199 200 201 202 203 204 205 206
        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 = (copy-seq vec)
        unless (and (= (length result) len)
                    (equal (array-element-type vec) (array-element-type result))
                    (equalp vec result))
        collect (list type vals result))
207 208 209 210
  nil)

(deftest copy-seq.24
  (loop for etype in '(short-float single-float long-float double-float)
sds's avatar
sds committed
211 212 213 214 215 216 217 218 219 220
        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 = (copy-seq vec)
        unless (and (= (length result) len)
                    (equal (array-element-type vec) (array-element-type result))
                    (equalp vec result))
        collect (list type vals result))
221 222
  nil)

223 224
;;; Order of evaluation test

225 226 227 228 229
(deftest copy-seq.order.1
  (let ((i 0))
    (values (copy-seq (progn (incf i) "abc")) i))
  "abc" 1)

230 231 232 233 234
(def-fold-test copy-seq.fold.1 (copy-seq '(a b c)))
(def-fold-test copy-seq.fold.2 (copy-seq #(a b c)))
(def-fold-test copy-seq.fold.3 (copy-seq #*01101100))
(def-fold-test copy-seq.fold.4 (copy-seq "abcdef"))

235 236 237
;;; Error tests

(deftest copy-seq.error.1
238 239
  (check-type-error #'copy-seq #'sequencep)
  nil)
240 241

(deftest copy-seq.error.4
242 243
  (signals-error (copy-seq) program-error)
  t)
244 245

(deftest copy-seq.error.5
246 247
  (signals-error (copy-seq "abc" 2 nil) program-error)
  t)
248 249

(deftest copy-seq.error.6
250 251
  (signals-error (locally (copy-seq 10) t) type-error)
  t)