source: trunk/tests/ansi-tests/with-package-iterator.lsp @ 9045

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

Assorted cleanup:

In infrastructure:

  • add *test-verbose* and :verbose argument to do-test and do-tests. Avoid random output if false, only show failures
  • muffle-wawrnings and/or bind *suppress-compiler-warnings* in some tests that unavoidably generate them (mainly with duplicate typecase/case clauses)
  • Add record-source-file for tests so meta-. can find them
  • If *catch-errors* (or the :catch-errors arg) is :break, enter a breakloop when catch an error
  • Make test fns created by *compile-tests* have names, so can find them in backtraces
  • fix misc compiler warnings
  • Fixed cases of duplicate test numbers
  • Disable note :make-condition-with-compound-name for openmcl.

In tests themselves:

I commented out the following tests with #+bogus-test, because they just seemed wrong to me:

lambda.47
lambda.50
upgraded-array-element-type.8
upgraded-array-element-type.nil.1
pathname-match-p.5
load.17
load.18
macrolet.47
ctypecase.15

In addition, I commented out the following tests with #+bogus-test because I was too lazy to make a note
for "doesn't signal underflow":

exp.error.8 exp.error.9 exp.error.10 exp.error.11 expt.error.8 expt.error.9 expt.error.10 expt.error.11

Finally, I entered bug reports in trac, and then commented out the tests
below with #+known-bug-NNN, where nnn is the ticket number in trac:

ticket#268: encode-universal-time.3 encode-universal-time.3.1
ticket#269: macrolet.36
ticket#270: values.20 values.21
ticket#271: defclass.error.13 defclass.error.22
ticket#272: phase.10 phase.12 asin.5 asin.6 asin.8
ticket#273: phase.18 phase.19 acos.8
ticket#274: exp.error.4 exp.error.5 exp.error.6 exp.error.7
ticket#275: car.error.2 cdr.error.2
ticket#276: map.error.11
ticket#277: subtypep.cons.43
ticket#278: subtypep-function.3
ticket#279: subtypep-complex.8
ticket#280: open.output.19 open.io.19 file-position.8 file-length.4 file-length.5 read-byte.4 stream-element-type.2 stream-element-type.3
ticket#281: open.65
ticket#288: set-syntax-from-char.sharp.1

File size: 4.7 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      (when *test-verbose* (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      (when *test-verbose* (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      (when *test-verbose* (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.