loop.lsp 1.98 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 26 27 28 29 30 31 32 33 34 35 36 37 38
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Fri Oct 25 18:48:59 2002
;;;; Contains: Tests of LOOP

(in-package :cl-test)

;;; Simple loops
(deftest sloop.1
  (loop (return 'a))
  a)

(deftest sloop.2
  (loop (return (values))))

(deftest sloop.3
  (loop (return (values 'a 'b 'c 'd)))
  a b c d)

(deftest sloop.4
  (block nil
    (loop (return 'a))
    'b)
  b)

(deftest sloop.5
  (let ((i 0) (x nil))
    (loop
     (when (>= i 4) (return x))
     (incf i)
     (push 'a x)))
  (a a a a))

(deftest sloop.6
  (let ((i 0) (x nil))
    (block foo
      (tagbody
       (loop
sds's avatar
sds committed
39 40 41
        (when (>= i 4) (go a))
        (incf i)
        (push 'a x))
42 43 44 45 46 47 48 49 50 51 52 53
       a
       (return-from foo x))))
  (a a a a))

(deftest sloop.7
  (catch 'foo
    (let ((i 0) (x nil))
    (loop
     (when (>= i 4) (throw 'foo x))
     (incf i)
     (push 'a x))))
  (a a a a))
54 55 56 57 58 59 60 61 62 63

;;; Loop errors

(def-macro-test loop.error.1 (loop))

(deftest loop-finish.error.1
  (block done
    (loop
     for i from 1 to 10
     do (macrolet
sds's avatar
sds committed
64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82
            ((%m (&environment env)
                 (let ((mfn (macro-function 'loop-finish env)))
                   (cond
                    ((not mfn) '(return-from done :fail1))
                    ((not (eval `(signals-error (funcall ,mfn)
                                                program-error)))
                     '(return-from done :fail2))
                    ((not (eval `(signals-error (funcall ,mfn
                                                         '(loop-finish))
                                                program-error)))
                     '(return-from done :fail3))

                    ((not (eval `(signals-error (funcall ,mfn
                                                         '(loop-finish)
                                                         nil nil)
                                                program-error)))
                     '(return-from done :fail4))
                    (t '(return-from done :good))))))
          (%m))))
83
  :good)