source: trunk/source/tests/ansi-tests/with-package-iterator.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: 4.6 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sat Apr 25 08:03:36 1998
4;;;; Contains: Tests of WITH-PACKAGE-ITERATOR
5
6(in-package :cl-test)
7(declaim (optimize (safety 3)))
8
9(compile-and-load "package-aux.lsp")
10
11;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12;;; with-package-iterator
13
14(deftest with-package-iterator.1
15  (with-package-iterator-internal (list (find-package "COMMON-LISP-USER")))
16  t)
17
18(deftest with-package-iterator.2
19  (with-package-iterator-external (list (find-package "COMMON-LISP-USER")))
20  t)
21
22(deftest with-package-iterator.3
23  (with-package-iterator-inherited (list (find-package "COMMON-LISP-USER")))
24  t)
25
26(deftest with-package-iterator.4
27  (with-package-iterator-all (list (find-package "COMMON-LISP-USER")))
28  t)
29
30;;; Should test on some packages containing shadowed symbols,
31;;; multiple inheritance
32
33(deftest with-package-iterator.5
34  (progn
35    (set-up-packages)
36    (with-package-iterator-all '("A")))
37  t)
38
39(deftest with-package-iterator.6
40  (progn
41    (set-up-packages)
42    (with-package-iterator-all '(#:|A|)))
43  t)
44
45(deftest with-package-iterator.7
46  (progn
47    (set-up-packages)
48    (with-package-iterator-all '(#\A)))
49  t)
50
51(deftest with-package-iterator.8
52  (progn
53    (set-up-packages)
54    (with-package-iterator-internal (list (find-package "A"))))
55  t)
56
57(deftest with-package-iterator.9
58  (progn
59    (set-up-packages)
60    (with-package-iterator-external (list (find-package "A"))))
61  t)
62
63(deftest with-package-iterator.10
64  (progn
65    (set-up-packages)
66    (with-package-iterator-inherited (list (find-package "A"))))
67  t)
68
69(deftest with-package-iterator.11
70  (signals-error
71   (with-package-iterator (x "COMMON-LISP-USER"))
72   program-error)
73  t)
74
75;;; Apply to all packages
76(deftest with-package-iterator.12
77  (loop
78   for p in (list-all-packages) count
79   (handler-case
80    (progn
81      (format t "Package ~S~%" p)
82      (not (with-package-iterator-internal (list p))))
83    (error (c)
84           (format "Error ~S on package ~A~%" c p)
85           t)))
86  0)
87
88(deftest with-package-iterator.13
89  (loop
90   for p in (list-all-packages) count
91   (handler-case
92    (progn
93      (format t "Package ~S~%" p)
94      (not (with-package-iterator-external (list p))))
95    (error (c)
96           (format "Error ~S on package ~A~%" c p)
97           t)))
98  0)
99
100(deftest with-package-iterator.14
101  (loop
102   for p in (list-all-packages) count
103   (handler-case
104    (progn
105      (format t "Package ~S~%" p)
106      (not (with-package-iterator-inherited (list p))))
107    (error (c)
108           (format t "Error ~S on package ~S~%" c p)
109           t)))
110  0)
111
112(def-macro-test with-package-iterator.error.1
113  (with-package-iterator (x "CL" :external) nil))
114
115
116;;; Specialized sequence tests
117
118(defmacro def-with-package-iterator-test (test-name name-form)
119  `(deftest ,test-name
120     (let ((name ,name-form))
121       (safely-delete-package name)
122       (let* ((p (make-package name :use nil))
123              (result nil)
124              (s (intern "X" p)))
125         (with-package-iterator
126          (x name :internal)
127          (loop
128           (multiple-value-bind
129               (good? sym)
130               (x)
131               (unless good?
132                 (safely-delete-package name)
133                 (return (equalt (list s) result)))
134             (push sym result))))))
135     t))
136
137(def-with-package-iterator-test with-package-iterator.15
138  (make-array 5 :initial-contents "TEST1"
139              :element-type 'base-char))
140
141(def-with-package-iterator-test with-package-iterator.16
142  (make-array 8 :initial-contents "TEST1XXX"
143              :fill-pointer 5
144              :element-type 'base-char))
145
146(def-with-package-iterator-test with-package-iterator.17
147  (make-array 8 :initial-contents "TEST1XXX"
148              :fill-pointer 5
149              :element-type 'character))
150
151(def-with-package-iterator-test with-package-iterator.18
152  (make-array 5 :initial-contents "TEST1"
153              :adjustable t
154              :element-type 'base-char))
155
156(def-with-package-iterator-test with-package-iterator.19
157  (make-array 5 :initial-contents "TEST1"
158              :adjustable t
159              :element-type 'character))
160
161(def-with-package-iterator-test with-package-iterator.20
162  (let* ((etype 'base-char)
163         (name0 (make-array 10 :initial-contents "XTEST1YzYY"
164                            :element-type etype)))
165    (make-array 5 :element-type etype
166                :displaced-to name0
167                :displaced-index-offset 1)))
168
169(def-with-package-iterator-test with-package-iterator.21
170  (let* ((etype 'character)
171         (name0 (make-array 10 :initial-contents "XTEST1YzYY"
172                            :element-type etype)))
173    (make-array 5 :element-type etype
174                :displaced-to name0
175                :displaced-index-offset 1)))
176
177;;; Free declaration scope
178
179(deftest with-package-iterator.22
180  (block done
181    (let ((x :bad))
182      (declare (special x))
183      (let ((x :good))
184        (with-package-iterator (s (return-from done x) :internal)
185                               (declare (special x))))))
186  :good)
Note: See TracBrowser for help on using the repository browser.