loop5.lsp 6.47 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sat Nov  2 13:52:50 2002
;;;; Contains: Tests of LOOP clause FOR-AS-ACROSS

(in-package :cl-test)

(deftest loop.5.1
  (let ((x "abcd")) (loop for e across x collect e))
  (#\a #\b #\c #\d))

(deftest loop.5.2
  (let ((x "abcd")) (loop for e across (the string x) collect e))
  (#\a #\b #\c #\d))

(deftest loop.5.3
  (let ((x "abcd")) (loop for e across (the simple-string x) collect e))
  (#\a #\b #\c #\d))

(deftest loop.5.4
  (loop for e across "abcd" collect e)
  (#\a #\b #\c #\d))

(deftest loop.5.5
  (loop for e across "abcd"
sds's avatar
sds committed
26
        for i from 1 to 3 collect e)
27 28 29 30
  (#\a #\b #\c))

(deftest loop.5.6
  (loop for e of-type base-char across "abcd"
sds's avatar
sds committed
31
        for i from 1 to 3 collect e)
32 33 34
  (#\a #\b #\c))

(deftest loop.5.7
pfdietz's avatar
pfdietz committed
35
  (let ((x (make-array '(4) :initial-contents "abcd" :element-type 'base-char)))
36
    (loop for e across (the base-string x) collect e))
37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65
  (#\a #\b #\c #\d))

(deftest loop.5.8
  (let ((x "abcd")) (loop for e of-type character across x collect e))
  (#\a #\b #\c #\d))

(deftest loop.5.10
  (let ((x #*00010110))
    (loop for e across x collect e))
  (0 0 0 1 0 1 1 0))

(deftest loop.5.11
  (let ((x #*00010110))
    (loop for e across (the bit-vector x) collect e))
  (0 0 0 1 0 1 1 0))

(deftest loop.5.12
  (let ((x #*00010110))
    (loop for e across (the simple-bit-vector x) collect e))
  (0 0 0 1 0 1 1 0))

(deftest loop.5.13
  (let ((x #*00010110))
    (loop for e of-type bit across (the simple-bit-vector x) collect e))
  (0 0 0 1 0 1 1 0))

(deftest loop.5.14
  (let ((x #*00010110))
    (loop for e of-type bit across x
sds's avatar
sds committed
66
          for i from 1 to 4 collect e))
67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92
  (0 0 0 1))


(deftest loop.5.20
  (let ((x (vector 'a 'b 'c 'd)))
    (loop for e across x collect e))
  (a b c d))

(deftest loop.5.21
  (let ((x (vector 'a 'b 'c 'd)))
    (loop for e across (the vector x) collect e))
  (a b c d))

(deftest loop.5.22
  (let ((x (vector 'a 'b 'c 'd)))
    (loop for e across (the simple-vector x) collect e))
  (a b c d))

(deftest loop.5.23
  (let ((x (vector '(a) '(b) '(c) '(d))))
    (loop for (e) across x collect e))
  (a b c d))


(deftest loop.5.30
  (let ((x (make-array '(5) :initial-contents '(a b c d e)
sds's avatar
sds committed
93
                  :adjustable t)))
94 95 96 97 98
    (loop for e across x collect e))
  (a b c d e))

(deftest loop.5.32
  (let* ((x (make-array '(5) :initial-contents '(a b c d e)))
sds's avatar
sds committed
99 100
         (y (make-array '(3) :displaced-to x
                   :displaced-index-offset 1)))
101 102 103
    (loop for e across y collect e))
  (b c d))

104
;;; tests of 'as' form
105

106 107 108 109 110 111 112
(deftest loop.5.33
  (loop as e across "abc" collect e)
  (#\a #\b #\c))

(deftest loop.5.34
  (loop as e of-type character across "abc" collect e)
  (#\a #\b #\c))
113

114 115
(deftest loop.5.35
  (loop as e of-type integer across (the simple-vector (coerce '(1 2 3) 'simple-vector))
sds's avatar
sds committed
116
        sum e)
117
  6)
118

119 120 121 122
;;; Loop across displaced vectors

(deftest loop.5.36
  (let* ((a (make-array '(10) :initial-contents '(a b c d e f g h i j)))
sds's avatar
sds committed
123 124
         (da (make-array '(5) :displaced-to a
                         :displaced-index-offset 2)))
125 126 127 128 129
    (loop for e across da collect e))
  (c d e f g))

(deftest loop.5.37
  (let* ((a (make-array '(10) :element-type 'base-char
sds's avatar
sds committed
130 131 132 133
                        :initial-contents "abcdefghij"))
         (da (make-array '(5) :element-type 'base-char
                         :displaced-to a
                         :displaced-index-offset 2)))
134 135 136 137 138
    (loop for e across da collect e))
  (#\c #\d #\e #\f #\g))

(deftest loop.5.38
  (let* ((a (make-array '(10) :element-type 'bit
sds's avatar
sds committed
139 140 141 142
                        :initial-contents '(0 1 1 0 0 1 0 1 1 1)))
         (da (make-array '(5) :element-type 'bit
                         :displaced-to a
                         :displaced-index-offset 2)))
143 144 145
    (loop for e across da collect e))
  (1 0 0 1 0))

146 147
(deftest loop.5.39
  (let ((v (make-array '(10) :initial-contents '(1 2 3 4 5 6 7 8 9 10)
sds's avatar
sds committed
148
                       :fill-pointer 6)))
149 150 151 152 153
    (loop for x across v collect x))
  (1 2 3 4 5 6))

(deftest loop.5.40
  (loop for i from 1 to 40
sds's avatar
sds committed
154 155 156 157 158 159
        for type = `(unsigned-byte ,i)
        for v = (make-array '(10) :initial-contents '(0 0 1 1 0 1 1 1 0 0)
                            :element-type type)
        for r = (loop for x across v collect x)
        unless (equal r '(0 0 1 1 0 1 1 1 0 0))
        collect (list i r))
160 161 162 163
  nil)

(deftest loop.5.41
  (loop for i from 1 to 40
sds's avatar
sds committed
164 165 166 167 168 169
        for type = `(signed-byte ,i)
        for v = (make-array '(10) :initial-contents '(0 0 -1 -1 0 -1 -1 -1 0 0)
                            :element-type type)
        for r = (loop for x across v collect x)
        unless (equal r '(0 0 -1 -1 0 -1 -1 -1 0 0))
        collect (list i r))
170 171 172 173 174
  nil)

(deftest loop.5.42
  (let ((vals '(0 0 1 1 0 1 1 1 0 0)))
    (loop for type in '(short-float single-float double-float long-float)
sds's avatar
sds committed
175 176 177 178 179
          for fvals = (loop for v in vals collect (coerce v type))
          for v = (make-array '(10) :initial-contents fvals :element-type type)
          for r = (loop for x across v collect x)
          unless (equal r fvals)
          collect (list fvals r)))
180 181 182 183 184
  nil)

(deftest loop.5.43
  (let ((vals '(0 0 1 1 0 1 1 1 0 0)))
    (loop for etype in '(short-float single-float double-float long-float)
sds's avatar
sds committed
185 186 187 188 189 190
          for type = `(complex ,etype)
          for fvals = (loop for v in vals collect (coerce v type))
          for v = (make-array '(10) :initial-contents fvals :element-type type)
          for r = (loop for x across v collect x)
          unless (equal r fvals)
          collect (list fvals r)))
191
  nil)
192

193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210
;;; Test that explicit calls to macroexpand in subforms
;;; are done in the correct environment

(deftest loop.5.44
  (macrolet
   ((%m (z) z))
   (loop for x across (expand-in-current-env (%m "148X")) collect x))
  (#\1 #\4 #\8 #\X))

(deftest loop.5.45
  (macrolet
   ((%m (z) z))
   (loop as x across (expand-in-current-env (%m #*00110110)) collect x))
  (0 0 1 1 0 1 1 0))

;;; FIXME
;;; Add tests for other specialized array types (integer types, floats, complex)

211 212 213
;;; Error cases

(deftest loop.5.error.1
214 215 216 217
  (signals-error
   (loop for (e . e) across (vector '(x . y) '(u . v)) collect e)
   program-error)
  t)
218 219

(deftest loop.5.error.2
220
  (signals-error
221
   (loop for e across (vector '(x . y) '(u . v))
sds's avatar
sds committed
222
         for e from 1 to 5 collect e)
223 224
   program-error)
  t)
225 226

(deftest loop.5.error.3
227 228 229 230 231
  (signals-error
   (macroexpand
    '(loop for (e . e) across (vector '(x . y) '(u . v)) collect e))
   program-error)
  t)
232 233

(deftest loop.5.error.4
234
  (signals-error
235 236
   (macroexpand
    '(loop for e across (vector '(x . y) '(u . v))
sds's avatar
sds committed
237
           for e from 1 to 5 collect e))
238 239
   program-error)
  t)