54 |
(with-package-iterator-inherited (list (find-package "A"))) |
(with-package-iterator-inherited (list (find-package "A"))) |
55 |
t) |
t) |
56 |
|
|
|
;;; Check that if no access symbols are provided, a program error is |
|
|
;;; raised |
|
|
#| |
|
57 |
(deftest with-package-iterator.11 |
(deftest with-package-iterator.11 |
58 |
(handler-case |
(signals-error |
59 |
(progn |
(with-package-iterator (x "COMMON-LISP-USER")) |
60 |
(test-with-package-iterator (list (find-package "COMMON-LISP-USER"))) |
program-error) |
|
nil) |
|
|
(program-error () t) |
|
|
(error (c) c)) |
|
|
t) |
|
|
|# |
|
|
|
|
|
;;; Paul Werkowski" <pw@snoopy.mv.com> pointed out that |
|
|
;;; that test is broken. Here's a version of the replacement |
|
|
;;; he suggested. |
|
|
;; |
|
|
;;; I'm not sure if this is correct either; it depends on |
|
|
;;; whether with-package-iterator should signal the error |
|
|
;;; at macro expansion time or at run time. |
|
|
;; |
|
|
|
|
|
(deftest with-package-iterator.11 |
|
|
(handler-case (macroexpand-1 |
|
|
'(with-package-iterator (x "COMMON-LISP-USER"))) |
|
|
(program-error () t) |
|
|
(error (c) c)) |
|
61 |
t) |
t) |
62 |
|
|
63 |
;;; Apply to all packages |
;;; Apply to all packages |
99 |
|
|
100 |
(def-macro-test with-package-iterator.error.1 |
(def-macro-test with-package-iterator.error.1 |
101 |
(with-package-iterator (x "CL" :external) nil)) |
(with-package-iterator (x "CL" :external) nil)) |
102 |
|
|
103 |
|
|
104 |
|
;;; Specialized sequence tests |
105 |
|
|
106 |
|
(defmacro def-with-package-iterator-test (test-name name-form) |
107 |
|
`(deftest ,test-name |
108 |
|
(let ((name ,name-form)) |
109 |
|
(safely-delete-package name) |
110 |
|
(let* ((p (make-package name :use nil)) |
111 |
|
(result nil) |
112 |
|
(s (intern "X" p))) |
113 |
|
(with-package-iterator |
114 |
|
(x name :internal) |
115 |
|
(loop |
116 |
|
(multiple-value-bind |
117 |
|
(good? sym) |
118 |
|
(x) |
119 |
|
(unless good? |
120 |
|
(safely-delete-package name) |
121 |
|
(return (equalt (list s) result))) |
122 |
|
(push sym result)))))) |
123 |
|
t)) |
124 |
|
|
125 |
|
(def-with-package-iterator-test with-package-iterator.15 |
126 |
|
(make-array 5 :initial-contents "TEST1" |
127 |
|
:element-type 'base-char)) |
128 |
|
|
129 |
|
(def-with-package-iterator-test with-package-iterator.16 |
130 |
|
(make-array 8 :initial-contents "TEST1XXX" |
131 |
|
:fill-pointer 5 |
132 |
|
:element-type 'base-char)) |
133 |
|
|
134 |
|
(def-with-package-iterator-test with-package-iterator.17 |
135 |
|
(make-array 8 :initial-contents "TEST1XXX" |
136 |
|
:fill-pointer 5 |
137 |
|
:element-type 'character)) |
138 |
|
|
139 |
|
(def-with-package-iterator-test with-package-iterator.18 |
140 |
|
(make-array 5 :initial-contents "TEST1" |
141 |
|
:adjustable t |
142 |
|
:element-type 'base-char)) |
143 |
|
|
144 |
|
(def-with-package-iterator-test with-package-iterator.19 |
145 |
|
(make-array 5 :initial-contents "TEST1" |
146 |
|
:adjustable t |
147 |
|
:element-type 'character)) |
148 |
|
|
149 |
|
(def-with-package-iterator-test with-package-iterator.20 |
150 |
|
(let* ((etype 'base-char) |
151 |
|
(name0 (make-array 10 :initial-contents "XTEST1YzYY" |
152 |
|
:element-type etype))) |
153 |
|
(make-array 5 :element-type etype |
154 |
|
:displaced-to name0 |
155 |
|
:displaced-index-offset 1))) |
156 |
|
|
157 |
|
(def-with-package-iterator-test with-package-iterator.21 |
158 |
|
(let* ((etype 'character) |
159 |
|
(name0 (make-array 10 :initial-contents "XTEST1YzYY" |
160 |
|
:element-type etype))) |
161 |
|
(make-array 5 :element-type etype |
162 |
|
:displaced-to name0 |
163 |
|
:displaced-index-offset 1))) |