source: trunk/source/tests/ansi-tests/loop.lsp @ 8991

Last change on this file since 8991 was 8991, checked in by gz, 11 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

File size: 1.5 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Fri Oct 25 18:48:59 2002
4;;;; Contains: Tests of LOOP
5
6(in-package :cl-test)
7
8;;; Simple loops
9(deftest sloop.1
10  (loop (return 'a))
11  a)
12
13(deftest sloop.2
14  (loop (return (values))))
15
16(deftest sloop.3
17  (loop (return (values 'a 'b 'c 'd)))
18  a b c d)
19
20(deftest sloop.4
21  (block nil
22    (loop (return 'a))
23    'b)
24  b)
25
26(deftest sloop.5
27  (let ((i 0) (x nil))
28    (loop
29     (when (>= i 4) (return x))
30     (incf i)
31     (push 'a x)))
32  (a a a a))
33
34(deftest sloop.6
35  (let ((i 0) (x nil))
36    (block foo
37      (tagbody
38       (loop
39        (when (>= i 4) (go a))
40        (incf i)
41        (push 'a x))
42       a
43       (return-from foo x))))
44  (a a a a))
45
46(deftest sloop.7
47  (catch 'foo
48    (let ((i 0) (x nil))
49    (loop
50     (when (>= i 4) (throw 'foo x))
51     (incf i)
52     (push 'a x))))
53  (a a a a))
54
55;;; Loop errors
56
57(def-macro-test loop.error.1 (loop))
58
59(deftest loop-finish.error.1
60  (block done
61    (loop
62     for i from 1 to 10
63     do (macrolet
64            ((%m (&environment env)
65                 (let ((mfn (macro-function 'loop-finish env)))
66                   (cond
67                    ((not mfn) '(return-from done :fail1))
68                    ((not (eval `(signals-error (funcall ,mfn)
69                                                program-error)))
70                     '(return-from done :fail2))
71                    ((not (eval `(signals-error (funcall ,mfn
72                                                         '(loop-finish))
73                                                program-error)))
74                     '(return-from done :fail3))
75                       
76                    ((not (eval `(signals-error (funcall ,mfn
77                                                         '(loop-finish)
78                                                         nil nil)
79                                                program-error)))
80                     '(return-from done :fail4))
81                    (t '(return-from done :good))))))
82          (%m))))
83  :good)
Note: See TracBrowser for help on using the repository browser.