dostar.lsp 3.81 KB
Newer Older
pfdietz's avatar
pfdietz committed
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sat Jan  8 07:26:22 2005
;;;; Contains: Tests of DO*

(in-package :cl-test)


(deftest do*.1
  (do* ((i 0 (1+ i)))
      ((>= i 10) i))
  10)

(deftest do*.2
  (do* ((i 0 (1+ j))
        (j 0 (1+ i)))
      ((>= i 10) (+ i j)))
  23)

(deftest do*.3
  (let ((x nil))
    (do* ((i 0 (1+ i)))
sds's avatar
sds committed
23
        ((>= i 10) x)
pfdietz's avatar
pfdietz committed
24 25 26 27 28 29
      (push i x)))
  (9 8 7 6 5 4 3 2 1 0))

(deftest do*.4
  (let ((x nil))
    (do* ((i 0 (1+ i)))
sds's avatar
sds committed
30
        ((>= i 10) x)
pfdietz's avatar
pfdietz committed
31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51
      (declare (fixnum i))
      (push i x)))
  (9 8 7 6 5 4 3 2 1 0))

(deftest do*.5
  (do* ((i 0 (1+ i)))
      (nil)
    (when (> i 10) (return i)))
  11)

;;; Zero iterations
(deftest do*.6
  (do* ((i 0 (+ i 10)))
      ((> i -1) i)
    (return 'bad))
  0)

;;; Tests of go tags
(deftest do*.7
  (let ((x nil))
    (do* ((i 0 (1+ i)))
sds's avatar
sds committed
52
        ((>= i 10) x)
pfdietz's avatar
pfdietz committed
53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76
      (go around)
      small
      (push 'a x)
      (go done)
      big
      (push 'b x)
      (go done)
      around
      (if (> i 4) (go big) (go small))
      done))
  (b b b b b a a a a a))

;;; No increment form
(deftest do*.8
  (do* ((i 0 (1+ i))
       (x nil))
      ((>= i 10) x)
    (push 'a x))
  (a a a a a a a a a a))

;;; No do* locals
(deftest do*.9
  (let ((i 0))
    (do* ()
sds's avatar
sds committed
77
        ((>= i 10) i)
pfdietz's avatar
pfdietz committed
78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106
      (incf i)))
  10)

;;; Return of no values
(deftest do*.10
  (do* ((i 0 (1+ i)))
      ((> i 10) (values))))

;;; Return of two values
(deftest do*.11
  (do* ((i 0 (1+ i)))
      ((> i 10) (values i (1+ i))))
  11 12)

;;; The results* list is an implicit progn
(deftest do*.12
  (do* ((i 0 (1+ i)))
      ((> i 10) (incf i) (incf i) i))
  13)

(deftest do*.13
  (do* ((i 0 (1+ i)))
      ((> i 10)))
  nil)

;; Special var
(deftest do*.14
  (let ((x 0))
    (flet ((%f () (locally (declare (special i))
sds's avatar
sds committed
107
                           (incf x i))))
pfdietz's avatar
pfdietz committed
108
      (do* ((i 0 (1+ i)))
sds's avatar
sds committed
109 110 111
           ((>= i 10) x)
        (declare (special i))
        (%f))))
pfdietz's avatar
pfdietz committed
112 113 114 115 116 117
  45)

;;; Confirm that the variables in succesive iterations are
;;; identical
(deftest do*.15
  (mapcar #'funcall
sds's avatar
sds committed
118 119 120 121
          (let ((x nil))
            (do* ((i 0 (1+ i)))
                ((= i 5) x)
              (push #'(lambda () i) x))))
pfdietz's avatar
pfdietz committed
122 123
  (5 5 5 5 5))

124 125 126 127 128 129 130
;;; Scope of free declarations

(deftest do*.16
  (block done
    (let ((x :bad))
      (declare (special x))
      (let ((x :good))
sds's avatar
sds committed
131 132 133
        (do* ((i (return-from done x) 0))
            (t nil)
          (declare (special x))))))
134 135 136 137 138 139 140
  :good)

(deftest do*.17
  (block done
    (let ((x :good))
      (declare (special x))
      (let ((x :bad))
sds's avatar
sds committed
141 142 143
        (do* ((i 0 (return-from done x)))
            (nil nil)
          (declare (special x))))))
144 145 146 147 148 149 150
  :good)

(deftest do*.18
  (block done
    (let ((x :good))
      (declare (special x))
      (let ((x :bad))
sds's avatar
sds committed
151 152 153
        (do* ((i 0 0))
            ((return-from done x) nil)
          (declare (special x))))))
154 155 156 157 158 159 160
  :good)

(deftest do*.19
  (let ((x :good))
    (declare (special x))
    (let ((x :bad))
      (do* () (t x)
sds's avatar
sds committed
161
        (declare (special x)))))
162 163
  :good)

164 165 166 167 168 169 170 171
;;; Test that explicit calls to macroexpand in subforms
;;; are done in the correct environment

(deftest do*.20
  (let ((result 0))
    (macrolet
     ((%m (z) z))
     (do* ((x (expand-in-current-env (%m 1)) (1+ x)))
sds's avatar
sds committed
172 173
          ((> x 10) result)
          (incf result x))))
174 175 176 177 178 179 180
  55)

(deftest do*.21
  (let ((result 0))
    (macrolet
     ((%m (z) z))
     (do* ((x 1 (expand-in-current-env (%m (1+ x)))))
sds's avatar
sds committed
181 182
          ((> x 10) result)
          (incf result x))))
183 184 185 186 187 188 189
  55)

(deftest do*.22
  (let ((result 0))
    (macrolet
     ((%m (z) z))
     (do* ((x 1 (1+ x)))
sds's avatar
sds committed
190 191
          ((expand-in-current-env (%m (> x 10))) result)
          (incf result x))))
192 193 194 195 196 197 198
  55)

(deftest do*.23
  (let ((result 0))
    (macrolet
     ((%m (z) z))
     (do* ((x 1 (1+ x)))
sds's avatar
sds committed
199 200
          ((> x 10) (expand-in-current-env (%m result)))
          (incf result x))))
201 202
  55)

pfdietz's avatar
pfdietz committed
203 204
(def-macro-test do*.error.1
  (do* ((i 0 (1+ i))) ((= i 5) 'a)))