197 |
(safely-delete-package ph)))) |
(safely-delete-package ph)))) |
198 |
t) |
t) |
199 |
|
|
200 |
;; Also: need to check that *PACKAGE* is used as a default |
;; Check that *PACKAGE* is used as a default |
201 |
|
|
202 |
|
(deftest use-package.7 |
203 |
|
(let ((user-name "H") |
204 |
|
(used-name "G")) |
205 |
|
(safely-delete-package user-name) |
206 |
|
(safely-delete-package used-name) |
207 |
|
(let* ((pused (make-package used-name :use nil)) |
208 |
|
(puser (make-package user-name :use nil)) |
209 |
|
(sym1 (intern "FOO" pused))) |
210 |
|
(and |
211 |
|
(eqt (export sym1 pused) t) |
212 |
|
(null (package-used-by-list pused)) |
213 |
|
(null (package-used-by-list puser)) |
214 |
|
(null (package-use-list pused)) |
215 |
|
(null (package-use-list puser)) |
216 |
|
(eqt (let ((*package* puser)) (use-package pused)) t) ;; user will use used |
217 |
|
(multiple-value-bind (sym2 access) |
218 |
|
(find-symbol "FOO" puser) |
219 |
|
(and |
220 |
|
(eqt access :inherited) |
221 |
|
(eqt sym1 sym2))) |
222 |
|
(equal (package-use-list puser) (list pused)) |
223 |
|
(equal (package-used-by-list pused) (list puser)) |
224 |
|
(null (package-use-list pused)) |
225 |
|
(null (package-used-by-list puser)) |
226 |
|
(eqt (unuse-package pused puser) t) |
227 |
|
(null (find-symbol "FOO" puser))))) |
228 |
|
t) |
229 |
|
|
230 |
|
;;; Tests for specialized sequence arguments |
231 |
|
|
232 |
|
(defmacro def-use-package-test (test-name &key (user "H") (used "G")) |
233 |
|
`(deftest ,test-name |
234 |
|
(let ((user-name ,user) |
235 |
|
(used-name ,used)) |
236 |
|
(safely-delete-package user-name) |
237 |
|
(safely-delete-package used-name) |
238 |
|
(let* ((pused (make-package used-name :use nil)) |
239 |
|
(puser (make-package user-name :use nil)) |
240 |
|
(sym1 (intern "FOO" pused))) |
241 |
|
(and |
242 |
|
(eqt (export sym1 pused) t) |
243 |
|
(null (package-used-by-list pused)) |
244 |
|
(null (package-used-by-list puser)) |
245 |
|
(null (package-use-list pused)) |
246 |
|
(null (package-use-list puser)) |
247 |
|
(eqt (let ((*package* puser)) (use-package pused)) t) ;; user will use used |
248 |
|
(multiple-value-bind (sym2 access) |
249 |
|
(find-symbol "FOO" puser) |
250 |
|
(and |
251 |
|
(eqt access :inherited) |
252 |
|
(eqt sym1 sym2))) |
253 |
|
(equal (package-use-list puser) (list pused)) |
254 |
|
(equal (package-used-by-list pused) (list puser)) |
255 |
|
(null (package-use-list pused)) |
256 |
|
(null (package-used-by-list puser)) |
257 |
|
(eqt (unuse-package pused puser) t) |
258 |
|
(null (find-symbol "FOO" puser))))) |
259 |
|
t)) |
260 |
|
|
261 |
|
;;; Specialized user package designator |
262 |
|
|
263 |
|
(def-use-package-test use-package.10 |
264 |
|
:user (make-array 5 :initial-contents "TEST1" :element-type 'base-char)) |
265 |
|
|
266 |
|
(def-use-package-test use-package.11 |
267 |
|
:user (make-array 10 :initial-contents "TEST1ABCDE" |
268 |
|
:fill-pointer 5 :element-type 'base-char)) |
269 |
|
|
270 |
|
(def-use-package-test use-package.12 |
271 |
|
:user (make-array 10 :initial-contents "TEST1ABCDE" |
272 |
|
:fill-pointer 5 :element-type 'character)) |
273 |
|
|
274 |
|
(def-use-package-test use-package.13 |
275 |
|
:user (make-array 5 :initial-contents "TEST1" |
276 |
|
:adjustable t :element-type 'base-char)) |
277 |
|
|
278 |
|
(def-use-package-test use-package.14 |
279 |
|
:user (make-array 5 :initial-contents "TEST1" |
280 |
|
:adjustable t :element-type 'character)) |
281 |
|
|
282 |
|
(def-use-package-test use-package.15 |
283 |
|
:user (let* ((etype 'base-char) |
284 |
|
(name0 (make-array 10 :element-type etype |
285 |
|
:initial-contents "xxxxxTEST1"))) |
286 |
|
(make-array 5 :element-type etype |
287 |
|
:displaced-to name0 |
288 |
|
:displaced-index-offset 5))) |
289 |
|
|
290 |
|
(def-use-package-test use-package.16 |
291 |
|
:user |
292 |
|
(let* ((etype 'character) |
293 |
|
(name0 (make-array 10 :element-type etype |
294 |
|
:initial-contents "xxxxxTEST1"))) |
295 |
|
(make-array 5 :element-type etype |
296 |
|
:displaced-to name0 |
297 |
|
:displaced-index-offset 5))) |
298 |
|
|
299 |
|
;;; Specialed used package designator |
300 |
|
|
301 |
|
(def-use-package-test use-package.17 |
302 |
|
:used (make-array 5 :initial-contents "TEST1" :element-type 'base-char)) |
303 |
|
|
304 |
|
(def-use-package-test use-package.18 |
305 |
|
:used (make-array 10 :initial-contents "TEST1ABCDE" |
306 |
|
:fill-pointer 5 :element-type 'base-char)) |
307 |
|
|
308 |
|
(def-use-package-test use-package.19 |
309 |
|
:used (make-array 10 :initial-contents "TEST1ABCDE" |
310 |
|
:fill-pointer 5 :element-type 'character)) |
311 |
|
|
312 |
|
(def-use-package-test use-package.20 |
313 |
|
:used (make-array 5 :initial-contents "TEST1" |
314 |
|
:adjustable t :element-type 'base-char)) |
315 |
|
|
316 |
|
(def-use-package-test use-package.21 |
317 |
|
:used (make-array 5 :initial-contents "TEST1" |
318 |
|
:adjustable t :element-type 'character)) |
319 |
|
|
320 |
|
(def-use-package-test use-package.22 |
321 |
|
:used (let* ((etype 'base-char) |
322 |
|
(name0 (make-array 10 :element-type etype |
323 |
|
:initial-contents "xxxxxTEST1"))) |
324 |
|
(make-array 5 :element-type etype |
325 |
|
:displaced-to name0 |
326 |
|
:displaced-index-offset 5))) |
327 |
|
|
328 |
|
(def-use-package-test use-package.23 |
329 |
|
:used |
330 |
|
(let* ((etype 'character) |
331 |
|
(name0 (make-array 10 :element-type etype |
332 |
|
:initial-contents "xxxxxTEST1"))) |
333 |
|
(make-array 5 :element-type etype |
334 |
|
:displaced-to name0 |
335 |
|
:displaced-index-offset 5))) |
336 |
|
|
337 |
(deftest use-package.error.1 |
(deftest use-package.error.1 |
338 |
(signals-error (use-package) program-error) |
(signals-error (use-package) program-error) |