1 ;;;; miscellaneous tests of LOOP-related stuff
3 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; While most of SBCL is derived from the CMU CL system, the test
7 ;;;; files (like this one) were written from scratch after the fork
10 ;;;; This software is in the public domain and is provided with
11 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
12 ;;;; more information.
14 (in-package "CL-USER")
16 ;;; The bug reported by Alexei Dejneka on sbcl-devel 2001-09-03
18 (assert (equal (let ((hash (make-hash-table)))
19 (setf (gethash 'key1 hash
) 'val1
)
20 (setf (gethash 'key2 hash
) 'val2
)
21 (sort (loop for key being each hash-key in hash
26 ;;; Bug 81, reported by Wolfhard Buss on cmucl-help 2001-02-14, was
27 ;;; fixed by Alexey Dejneka's patch on sbcl-devel 2001-09-30.
28 (assert (equal '(0.0
1.0 2.0 3.0)
29 (loop with
(a . b
) of-type float
= '(0.0 .
1.0)
30 and
(c . d
) of-type float
= '(2.0 .
3.0)
31 return
(list a b c d
))))
33 ;;; a bug reported and fixed by Alexey Dejneka sbcl-devel 2001-10-05:
34 ;;; The type declarations should apply, hence under Python's
35 ;;; declarations-are-assertions rule, the code should signal a type
37 (assert (typep (nth-value 1
41 of-type float
= '(5 .
5)
42 return
(list a b
))))))
45 ;;; bug 103, reported by Arthur Lemmens sbcl-devel 2001-05-05,
46 ;;; fixed by Alexey Dejneka patch sbcl-devel 2001-10-05:
47 ;;; LOOP syntax requires that forms after INITIALLY, FINALLY, and DO
48 ;;; must be compound forms.
49 (multiple-value-bind (function warnings-p failure-p
)
55 (declare (ignore function warnings-p
))
58 ;;; a bug reported by Paul F. Dietz (in his ANSI test suite):
59 ;;; duplicate bindings in LOOP must signal errors of type
61 (assert (typep (nth-value 1
64 (loop for
(a . a
) in
'((1 .
2) (3 .
4))
68 ;;; similar to gcl/ansi-test LOOP.1.27, and fixed at the same time:
69 (assert (equal (loop for x downto
7 by
2 from
13 collect x
) '(13 11 9 7)))
71 ;;; some more from gcl/ansi-test:
72 (let ((table (make-hash-table)))
73 (setf (gethash 'foo table
) '(bar baz
))
74 (assert (= (loop for nil being the hash-keys of table count t
) 1))
75 (assert (equal (loop for nil being the hash-keys of table
76 using
(hash-value (v1 . v2
))
81 (assert (= (loop for nil being the external-symbols of
:cl count t
) 978))
82 (assert (= (loop for x being the external-symbols of
:cl count x
) 977))
84 (let ((*package
* (find-package :cl
)))
85 (assert (= (loop for x being each external-symbol count t
) 978)))
87 (assert (eq (loop for a
= (return t
) return nil
) t
))
89 (multiple-value-bind (result error
)
91 (loop for nil being the external-symbols of
:nonexistent-package
93 (assert (null result
))
94 (assert (typep error
'package-error
)))
96 (assert (equal (loop for i from
1 repeat
(the (integer 7 7) 7) collect i
)
99 (multiple-value-bind (result error
)
101 (eval '(loop for i from
1 repeat
7 of-type fixnum collect i
)))
102 (assert (null result
))
103 (assert (typep error
'program-error
)))
106 (ignore-errors (loop for i from
1 repeat
6.5 collect i
))
107 (ignore-errors (loop for i from
1 repeat
(eval '6.5) collect i
))))
109 (assert (eq (block nil
110 (loop named foo do
(loop-finish) finally
(return :good
))
114 (assert (= (loop with
(a nil
) = '(1 2) return a
) 1))
115 (assert (= (loop with
(nil a
) = '(1 2) return a
) 2))
116 (assert (= (loop with
(a . nil
) = '(1 2) return a
) 1))
117 (assert (equal (loop with
(nil . a
) = '(1 2) return a
) '(2)))
119 (multiple-value-bind (result error
)
121 (loop for i in
'(1 2 3) collect i always
(< i
4)))
122 (assert (null result
))
123 (assert (typep error
'program-error
)))
125 (loop for i in
'(1 2 3) collect i into foo always
(< i
4)
126 finally
(return foo
))
129 (loop for i in
'(1 2 3) collect i into foo always
(= i
4)
130 finally
(return foo
))
132 (multiple-value-bind (result error
)
134 (loop for i in
'(1 2 3) always
(< i
4) collect i
))
135 (assert (null result
))
136 (assert (typep error
'program-error
)))
138 (loop for i in
'(1 2 3) always
(< i
4) collect i into foo
139 finally
(return foo
))
142 (loop for i in
'(1 2 3) always
(= i
4) collect i into foo
143 finally
(return foo
))
145 (multiple-value-bind (result error
)
147 (loop for i in
'(1 2 3) thereis
(= i
3) collect i
))
148 (assert (null result
))
149 (assert (typep error
'program-error
)))
151 (multiple-value-bind (result error
)
153 (loop with i
= 1 for x from
1 to
3 collect x into i
))
154 (assert (null result
))
155 (assert (typep error
'program-error
)))
156 (multiple-value-bind (result error
)
157 ;; this one has a plausible interpretation in terms of LET*, but
158 ;; ANSI seems specifically to disallow it
160 (loop with i
= 1 with i
= (1+ i
)
163 (assert (null result
))
164 (assert (typep error
'program-error
)))
168 ;; this one just seems weird. Nevertheless...
169 (loop for i in
'(a b c d
)
173 '(a z b z c z d z
))))
175 (let ((ht (make-hash-table)))
176 (setf (gethash 1 ht
) 3)
177 (setf (gethash 7 ht
) 15)
178 (assert (= (loop for v fixnum being each hash-key in ht sum v
) 8))
179 (assert (= (loop for v fixnum being each hash-value in ht sum v
) 18))
180 (assert (raises-error?
(loop for v float being each hash-value in ht sum v
)