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

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

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

File size: 2.9 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sat Jan  8 07:26:48 2005
4;;;; Contains: Tests of DOLIST
5
6(in-package :cl-test)
7
8(deftest dolist.1
9  (let ((count 0))
10    (dolist (x '(a b nil d)) (incf count))
11    count)
12  4)
13
14(deftest dolist.2
15  (let ((count 0))
16    (dolist (x '(a nil c d) count) (incf count)))
17  4)
18
19(deftest dolist.3
20  (let ((count 0))
21    (dolist (x nil count) (incf count)))
22  0)
23
24(deftest dolist.4
25  (let ((y nil))
26    (flet ((%f () (locally (declare (special e))
27                           (push e y))))
28      (dolist (e '(a b c) (reverse y))
29        (declare (special e))
30        (%f))))
31  (a b c))
32
33;;; Tests that it's a tagbody
34(deftest dolist.5
35  (let ((even nil)
36        (odd nil))
37    (dolist (i '(1 2 3 4 5 6 7 8) (values (reverse even)
38                                          (reverse odd)))
39      (when (evenp i) (go even))
40      (push i odd)
41      (go done)
42      even
43      (push i even)
44      done))
45  (2 4 6 8)
46  (1 3 5 7))
47
48;;; Test that bindings are not normally special
49(deftest dolist.6
50  (let ((i 0) (y nil))
51    (declare (special i))
52    (flet ((%f () i))
53      (dolist (i '(1 2 3 4))
54        (push (%f) y)))
55    y)
56  (0 0 0 0))
57
58;;; Test multiple return values
59
60(deftest dolist.7
61  (dolist (x '(a b) (values))))
62
63(deftest dolist.8
64  (let ((count 0))
65    (dolist (x '(a b c) (values count count))
66      (incf count)))
67  3 3)
68
69;;; Test ability to return, and the scope of the implicit
70;;; nil block
71(deftest dolist.9
72  (block nil
73    (eqlt (dolist (x '(a b c))
74            (return 1))
75          1))
76  t)
77
78(deftest dolist.10
79  (block nil
80    (eqlt (dolist (x '(a b c))
81            (return-from nil 1))
82          1))
83  t)
84
85(deftest dolist.11
86  (block nil
87    (dolist (x (return 1)))
88    2)
89  2)
90
91(deftest dolist.12
92  (block nil
93    (dolist (x '(a b) (return 1)))
94    2)
95  2)
96
97;;; Check that binding of element var is visible in the result form
98(deftest dolist.13
99  (dolist (e '(a b c) e))
100  nil)
101
102(deftest dolist.14
103  (let ((e 1))
104    (dolist (e '(a b c) (setf e 2)))
105    e)
106  1)
107
108(deftest dolist.15
109  (let ((x nil))
110    (dolist (e '(a b c d e f))
111      (push e x)
112      (when (eq e 'c) (return x))))
113  (c b a))
114
115;;; Scope of free declarations
116
117(deftest dolist.16
118  (block done
119    (let ((x :bad))
120      (declare (special x))
121      (let ((x :good))
122        (dolist (e (return-from done x))
123          (declare (special x))))))
124  :good)
125
126(deftest dolist.17
127  (let ((x :good))
128    (declare (special x))
129    (let ((x :bad))
130      (dolist (e nil x)
131        (declare (special x)))))
132  :good)
133
134;;; Test that explicit calls to macroexpand in subforms
135;;; are done in the correct environment
136
137(deftest dolist.18
138  (let ((result nil))
139    (macrolet
140     ((%m (z) z))
141     (dolist (x (expand-in-current-env (%m '(a b c))) result)
142       (push x result))))
143  (c b a))
144
145(deftest dolist.19
146  (let ((result nil))
147    (macrolet
148     ((%m (z) z))
149     (dolist (x '(a b c) (expand-in-current-env (%m result)))
150       (push x result))))
151  (c b a))
152
153;;; Error tests
154
155(def-macro-test dolist.error.1
156  (dolist (x nil)))
157
Note: See TracBrowser for help on using the repository browser.