/[gcl]/gcl/ansi-tests/do-all-symbols.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/do-all-symbols.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by pfdietz, Sun Feb 22 13:33:58 2004 UTC revision 1.2 by pfdietz, Fri Dec 10 12:42:04 2004 UTC
# Line 9  Line 9 
9    (do-all-symbols (x)))    (do-all-symbols (x)))
10    
11  ;;; FIXME  Add tests for non-error cases  ;;; 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    

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26