source: trunk/source/tests/ansi-tests/do-all-symbols.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: 3.1 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sat Feb 21 18:27:22 2004
4;;;; Contains: Tests of DO-ALL-SYMBOLS
5
6(in-package :cl-test)
7
8(def-macro-test do-all-symbols.error.1
9  (do-all-symbols (x)))
10
11;;; FIXME  Add tests for non-error cases
12
13(deftest do-all-symbols.1
14  (let ((symbols nil))
15    (do-all-symbols (sym) (push sym symbols))
16    (let ((hash (make-hash-table :test 'eq)))
17      (with-package-iterator
18       (f (list-all-packages) :internal :external :inherited)
19       (loop
20        (multiple-value-bind (found sym) (f)
21          (unless found (return))
22          (setf (gethash sym hash) t))))
23      ;; hash now contains all symbols accessible in any package
24      ;; Check that all symbols from DO-ALL-SYMBOLS are in this
25      ;; package
26      (loop for s in symbols unless (gethash s hash) collect s)))
27  nil)
28
29;; This is the converse of do-all-symbols.1
30(deftest do-all-symbols.2
31  (let ((symbols nil))
32    (with-package-iterator
33     (f (list-all-packages) :internal :external :inherited)
34     (loop
35      (multiple-value-bind (found sym) (f)
36        (unless found (return))`
37        (push sym symbols))))
38    (let ((hash (make-hash-table :test 'eq)))
39      (do-all-symbols (s) (setf (gethash s hash) t))
40      (loop for s in symbols unless (gethash s hash) collect s)))
41  nil)
42
43(deftest do-all-symbols.3
44  (let ((sym (gensym)))
45    (do-all-symbols (s t) (assert (not (eq s sym)))))
46  t)
47
48(deftest do-all-symbols.4
49  (let ((x :bad))
50    (do-all-symbols (x x)))
51  nil)
52
53(deftest do-all-symbols.5
54  (block nil
55    (do-all-symbols (x (return :bad)))
56    :good)
57  :good)
58
59(deftest do-all-symbols.6
60  (do-all-symbols (x :bad) (return :good))
61  :good)
62
63(deftest do-all-symbols.7
64  (block done
65    (tagbody
66     (do-all-symbols (x (return-from done :good))
67       (go 1)
68       (return-from done :bad1)
69       1)
70     1
71     (return-from done :bad2)))
72  :good)
73
74(deftest do-all-symbols.8
75  (block done
76    (tagbody
77     (do-all-symbols (x (return-from done :good))
78       (go tag)
79       (return-from done :bad1)
80       tag)
81     tag
82     (return-from done :bad2)))
83  :good)
84
85;;; Test that do-all-symbols accepts declarations
86
87(deftest do-all-symbols.9
88  (let ((x 0)
89        (y 1))
90    (do-all-symbols (z nil)
91      (declare (type (integer * 0) x))
92      (declare (type (integer 1 *) y))
93      (declare (ignore z))
94      (when (< x y) (return :good))))
95  :good)
96
97
98;;; Default return is NIL
99
100(deftest do-all-symbols.10
101  (do-all-symbols (s) (declare (ignore s)))
102  nil)
103
104;;; Free declaration scope tests
105
106(deftest do-all-symbols.11
107  (let ((x :good))
108    (declare (special x))
109    (let ((x :bad))
110      (do-all-symbols (s x)
111        (declare (special x)))))
112  :good)
113
114;;; Executing a return actually terminates the loop
115
116(deftest do-all-symbols.12
117  (let ((should-have-returned nil))
118    (block done
119      (do-all-symbols (s :bad1)
120        (when should-have-returned
121          (return-from done :bad2))
122        (setq should-have-returned t)
123        (return :good))))
124  :good)
125
126;;; Test that explicit calls to macroexpand in subforms
127;;; are done in the correct environment
128
129(deftest do-all-symbols.13
130  (macrolet
131   ((%m (z) z))
132   (do-all-symbols (s (expand-in-current-env (%m :good)))))
133  :good)
Note: See TracBrowser for help on using the repository browser.