loop3.lsp 3.51 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sun Oct 27 08:36:36 2002
;;;; Contains: Tests of FOR-ON-AS-LIST iteration control in LOOP

(in-package :cl-test)

(deftest loop.3.1
  (loop for x on '(1 2 3) sum (car x))
  6)

(deftest loop.3.2
  (loop for x on '(1 2 3 4)
sds's avatar
sds committed
14
        do (when (evenp (car x)) (return x)))
15 16 17 18 19 20 21 22 23 24 25 26 27 28 29
  (2 3 4))


(deftest loop.3.3
  (loop for x on '(a b c . d) collect (car x))
  (a b c))

(deftest loop.3.4
  (let ((x nil))
    (loop for e on '(a b c d) do (push (car e) x))
    x)
  (d c b a))

(deftest loop.3.5
  (loop for e on '(a b c d e f) by #'cddr
sds's avatar
sds committed
30
        collect (car e))
31 32 33 34
  (a c e))

(deftest loop.3.6
  (loop for e on '(a b c d e f g) by #'cddr
sds's avatar
sds committed
35
        collect (car e))
36 37 38 39
  (a c e g))

(deftest loop.3.7
  (loop for e on '(a b c d e f)
sds's avatar
sds committed
40 41
        by #'(lambda (l) (and (cdr l) (cons (car l) (cddr l))))
        collect (car e))
42 43 44 45
  (a a a a a a))

(deftest loop.3.8
  (loop for ((x . y)) on '((a . b) (c . d) (e . f))
sds's avatar
sds committed
46
        collect (list x y))
47 48 49 50
  ((a b) (c d) (e f)))

(deftest loop.3.9
  (loop for ((x nil y)) on '((a b c) (d e f) (g h i))
sds's avatar
sds committed
51
        collect (list x y))
52 53 54 55
  ((a c) (d f) (g i)))

(deftest loop.3.10
  (loop for ((x y)) of-type (fixnum) on '((1 2) (3 4) (5 6))
sds's avatar
sds committed
56
        collect (+ x y))
57 58 59 60
  (3 7 11))

(deftest loop.3.11
  (loop for ((x y)) of-type (fixnum) on '((1 2) (3 4) (5 6))
sds's avatar
sds committed
61
        collect (+ x y))
62 63 64 65
  (3 7 11))

(deftest loop.3.12
  (loop for ((x y)) of-type ((fixnum fixnum)) on '((1 2) (3 4) (5 6))
sds's avatar
sds committed
66
        collect (+ x y))
67 68 69 70
  (3 7 11))

(deftest loop.3.13
  (loop for ((x . y)) of-type ((fixnum . fixnum)) on '((1 . 2) (3 . 4) (5 . 6))
sds's avatar
sds committed
71
        collect (+ x y))
72 73 74
  (3 7 11))

(deftest loop.3.14
75
  (signals-error
76
   (loop for x on '(a b c)
sds's avatar
sds committed
77
         for x on '(d e f) collect x)
78 79
   program-error)
  t)
80 81

(deftest loop.3.15
82
  (signals-error (loop for (x . x) on '((a b) (c d)) collect x)
sds's avatar
sds committed
83
                 program-error)
84
  t)
85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102

(deftest loop.3.16
  (loop for nil on nil do (return t))
  nil)

(deftest loop.3.17
  (let ((x '(a b c)))
    (values
     x
     (loop for x on '(d e f) collect x)
     x))
  (a b c)
  ((d e f) (e f) (f))
  (a b c))

(deftest loop.3.18
  (loop for (x) of-type ((integer 0 10)) on '(2 4 6 7) sum x)
  19)
sds's avatar
sds committed
103

104 105 106 107 108 109 110 111
;;; Tests of the 'AS' form

(deftest loop.3.19
  (loop as x on '(1 2 3) sum (car x))
  6)

(deftest loop.3.20
  (loop as x on '(a b c)
sds's avatar
sds committed
112 113
        as y on '(1 2 3)
        collect (list (car x) (car y)))
114 115 116 117
  ((a 1) (b 2) (c 3)))

(deftest loop.3.21
  (loop as x on '(a b c)
sds's avatar
sds committed
118 119
        for y on '(1 2 3)
        collect (list (car x) (car y)))
120 121 122 123
  ((a 1) (b 2) (c 3)))

(deftest loop.3.22
  (loop for x on '(a b c)
sds's avatar
sds committed
124 125
        as y on '(1 2 3)
        collect (list (car x) (car y)))
126 127 128 129 130 131
  ((a 1) (b 2) (c 3)))

(deftest loop.3.23
  (let (a b (i 0))
    (values
     (loop for e on (progn (setf a (incf i))
sds's avatar
sds committed
132 133 134
                           '(a b c d e f g))
           by (progn (setf b (incf i)) #'cddr)
           collect (car e))
135 136 137
     a b i))
  (a c e g)
  1 2 2)
138 139 140 141 142 143 144 145 146 147 148 149 150 151

;;; Test that explicit calls to macroexpand in subforms
;;; are done in the correct environment

(deftest loop.3.24
  (macrolet
   ((%m (z) z))
   (loop for x on (expand-in-current-env (%m '(1 2 3))) sum (car x)))
  6)

(deftest loop.3.25
  (macrolet
   ((%m (z) z))
   (loop for e on (expand-in-current-env (%m '(a b c d e f))) by #'cddr
sds's avatar
sds committed
152
         collect (car e)))
153 154 155 156 157 158
  (a c e))

(deftest loop.3.26
  (macrolet
   ((%m (z) z))
   (loop for e on '(a b c d e f)
sds's avatar
sds committed
159 160
         by (expand-in-current-env (%m #'cddr))
         collect (car e)))
161 162 163 164 165 166 167
  (a c e))

(deftest loop.3.27
  (macrolet
   ((%m (z) z))
   (loop as x on (expand-in-current-env (%m '(1 2 3))) sum (car x)))
  6)