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
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
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
|
;-*- 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
(when (>= i 4) (go a))
(incf i)
(push 'a x))
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))
;;; 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
((%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))))
:good)
|
