260 |
(safely-delete-package p)))) |
(safely-delete-package p)))) |
261 |
t) |
t) |
262 |
|
|
263 |
|
;;; Specialized sequences as designators |
264 |
|
|
265 |
|
;;; The package name being a specialized sequence |
266 |
|
|
267 |
|
(defmacro def-make-package-test1 (test-name name-form) |
268 |
|
`(deftest ,test-name |
269 |
|
(let ((name ,name-form)) |
270 |
|
(assert (string= name "TEST1")) |
271 |
|
(safely-delete-package "TEST1") |
272 |
|
(let ((p (ignore-errors (make-package name)))) |
273 |
|
(prog1 |
274 |
|
(and (packagep p) |
275 |
|
(equalt (package-name p) "TEST1") |
276 |
|
(equalt (package-nicknames p) nil) |
277 |
|
(equalt (package-used-by-list p) nil)) |
278 |
|
(safely-delete-package p)))) |
279 |
|
t)) |
280 |
|
|
281 |
|
(def-make-package-test1 make-package.14 |
282 |
|
(make-array 5 :initial-contents "TEST1" |
283 |
|
:element-type 'base-char)) |
284 |
|
|
285 |
|
(def-make-package-test1 make-package.15 |
286 |
|
(make-array 12 :initial-contents "TEST1xxxyyyz" |
287 |
|
:fill-pointer 5 |
288 |
|
:element-type 'base-char)) |
289 |
|
|
290 |
|
(def-make-package-test1 make-package.16 |
291 |
|
(make-array 12 :initial-contents "TEST1xxxyyyz" |
292 |
|
:fill-pointer 5 |
293 |
|
:element-type 'character)) |
294 |
|
|
295 |
|
(def-make-package-test1 make-package.17 |
296 |
|
(make-array 5 :initial-contents "TEST1" |
297 |
|
:adjustable t |
298 |
|
:element-type 'base-char)) |
299 |
|
|
300 |
|
(def-make-package-test1 make-package.18 |
301 |
|
(make-array 5 :initial-contents "TEST1" |
302 |
|
:adjustable t |
303 |
|
:element-type 'character)) |
304 |
|
|
305 |
|
(def-make-package-test1 make-package.19 |
306 |
|
(let* ((etype 'base-char) |
307 |
|
(name0 (make-array 10 :initial-contents "xxTEST1yyy" |
308 |
|
:element-type etype))) |
309 |
|
(make-array 5 :element-type etype |
310 |
|
:displaced-to name0 |
311 |
|
:displaced-index-offset 2))) |
312 |
|
|
313 |
|
(def-make-package-test1 make-package.20 |
314 |
|
(let* ((etype 'character) |
315 |
|
(name0 (make-array 10 :initial-contents "xxTEST1yyy" |
316 |
|
:element-type etype))) |
317 |
|
(make-array 5 :element-type etype |
318 |
|
:displaced-to name0 |
319 |
|
:displaced-index-offset 2))) |
320 |
|
|
321 |
|
;;; Nicknames being specialized sequences |
322 |
|
|
323 |
|
(defmacro def-make-package-test2 (test-name name-form) |
324 |
|
`(deftest ,test-name |
325 |
|
(let ((name ,name-form) |
326 |
|
(nickname "TEST1-NICKNAME")) |
327 |
|
(safely-delete-package "TEST1") |
328 |
|
(safely-delete-package nickname) |
329 |
|
(let ((p (make-package name :nicknames (list nickname)))) |
330 |
|
(prog1 |
331 |
|
(and (packagep p) |
332 |
|
(equalt (package-name p) "TEST1") |
333 |
|
(equalt (package-nicknames p) (list nickname)) |
334 |
|
(equalt (package-used-by-list p) nil)) |
335 |
|
(safely-delete-package p)))) |
336 |
|
t)) |
337 |
|
|
338 |
|
(def-make-package-test2 make-package.21 |
339 |
|
(make-array 5 :initial-contents "TEST1" |
340 |
|
:element-type 'base-char)) |
341 |
|
|
342 |
|
(def-make-package-test2 make-package.22 |
343 |
|
(make-array 12 :initial-contents "TEST1xxxyyyz" |
344 |
|
:fill-pointer 5 |
345 |
|
:element-type 'base-char)) |
346 |
|
|
347 |
|
(def-make-package-test2 make-package.23 |
348 |
|
(make-array 12 :initial-contents "TEST1xxxyyyz" |
349 |
|
:fill-pointer 5 |
350 |
|
:element-type 'character)) |
351 |
|
|
352 |
|
(def-make-package-test2 make-package.24 |
353 |
|
(make-array 5 :initial-contents "TEST1" |
354 |
|
:adjustable t |
355 |
|
:element-type 'base-char)) |
356 |
|
|
357 |
|
(def-make-package-test2 make-package.25 |
358 |
|
(make-array 5 :initial-contents "TEST1" |
359 |
|
:adjustable t |
360 |
|
:element-type 'character)) |
361 |
|
|
362 |
|
(def-make-package-test2 make-package.26 |
363 |
|
(let* ((etype 'base-char) |
364 |
|
(name0 (make-array 10 :initial-contents "xxTEST1yyy" |
365 |
|
:element-type etype))) |
366 |
|
(make-array 5 :element-type etype |
367 |
|
:displaced-to name0 |
368 |
|
:displaced-index-offset 2))) |
369 |
|
|
370 |
|
(def-make-package-test2 make-package.27 |
371 |
|
(let* ((etype 'character) |
372 |
|
(name0 (make-array 10 :initial-contents "xxTEST1yyy" |
373 |
|
:element-type etype))) |
374 |
|
(make-array 5 :element-type etype |
375 |
|
:displaced-to name0 |
376 |
|
:displaced-index-offset 2))) |
377 |
|
|
378 |
|
;;; USE names being specialized sequences |
379 |
|
|
380 |
|
(defmacro def-make-package-test3 (test-name name-form) |
381 |
|
`(deftest ,test-name |
382 |
|
(let ((name ,name-form)) |
383 |
|
(safely-delete-package "TEST1") |
384 |
|
(assert (find-package name)) |
385 |
|
(let ((p (ignore-errors (make-package "TEST1" :use (list name))))) |
386 |
|
(prog1 |
387 |
|
(and (packagep p) |
388 |
|
(equalt (package-name p) "TEST1") |
389 |
|
(equalt (package-nicknames p) nil) |
390 |
|
(equalt (package-use-list p) (list (find-package name))) |
391 |
|
(equalt (package-used-by-list p) nil)) |
392 |
|
(safely-delete-package p)))) |
393 |
|
t)) |
394 |
|
|
395 |
|
(def-make-package-test3 make-package.28 |
396 |
|
(make-array 1 :initial-contents "A" :element-type 'base-char)) |
397 |
|
|
398 |
|
(def-make-package-test3 make-package.29 |
399 |
|
(make-array 8 :initial-contents "Axxxyyyz" |
400 |
|
:fill-pointer 1 |
401 |
|
:element-type 'base-char)) |
402 |
|
|
403 |
|
(def-make-package-test3 make-package.30 |
404 |
|
(make-array 8 :initial-contents "Axxxyyyz" |
405 |
|
:fill-pointer 1 |
406 |
|
:element-type 'character)) |
407 |
|
|
408 |
|
(def-make-package-test3 make-package.31 |
409 |
|
(make-array 1 :initial-contents "A" |
410 |
|
:adjustable t |
411 |
|
:element-type 'base-char)) |
412 |
|
|
413 |
|
(def-make-package-test3 make-package.32 |
414 |
|
(make-array 1 :initial-contents "A" |
415 |
|
:adjustable t |
416 |
|
:element-type 'character)) |
417 |
|
|
418 |
|
(def-make-package-test3 make-package.33 |
419 |
|
(let* ((etype 'base-char) |
420 |
|
(name0 (make-array 10 :initial-contents "xxAyyy0123" |
421 |
|
:element-type etype))) |
422 |
|
(make-array 1 :element-type etype |
423 |
|
:displaced-to name0 |
424 |
|
:displaced-index-offset 2))) |
425 |
|
|
426 |
|
(def-make-package-test3 make-package.34 |
427 |
|
(let* ((etype 'character) |
428 |
|
(name0 (make-array 10 :initial-contents "xxAzzzzyyy" |
429 |
|
:element-type etype))) |
430 |
|
(make-array 1 :element-type etype |
431 |
|
:displaced-to name0 |
432 |
|
:displaced-index-offset 2))) |
433 |
|
|
434 |
;; Signal a continuable error if the package or any nicknames |
;; Signal a continuable error if the package or any nicknames |
435 |
;; exist as packages or nicknames of packages |
;; exist as packages or nicknames of packages |
436 |
|
|