14 |
;; we don't examine it here. |
;; we don't examine it here. |
15 |
;; Try several ways of specifying the package name. |
;; Try several ways of specifying the package name. |
16 |
(deftest defpackage-1 |
(deftest defpackage-1 |
17 |
(handler-case |
(loop |
18 |
(loop |
for n in '("H" #:|H| #\H) count |
19 |
for n in '("H" #:|H| #\H) count |
(not |
20 |
(not |
(progn |
21 |
(progn |
(ignore-errors (delete-package "H")) |
22 |
(ignore-errors (delete-package "H")) |
(let ((p (ignore-errors (eval `(defpackage ,n))))) |
23 |
(let ((p (ignore-errors (eval `(defpackage ,n))))) |
(and |
24 |
(and |
(packagep p) |
25 |
(packagep p) |
(equal (package-name p) "H") |
26 |
(equal (package-name p) "H") |
;; (equal (package-use-list p) nil) |
27 |
;; (equal (package-use-list p) nil) |
(equal (package-used-by-list p) nil) |
28 |
(equal (package-used-by-list p) nil) |
(equal (package-nicknames p) nil) |
29 |
(equal (package-nicknames p) nil) |
(equal (package-shadowing-symbols p) nil) |
30 |
(equal (package-shadowing-symbols p) nil) |
(null (documentation p t)) |
31 |
(null (documentation p t)) |
))))) |
|
))))) |
|
|
(error (c) c)) |
|
32 |
0) |
0) |
33 |
|
|
34 |
;; Test :nicknames option |
;; Test :nicknames option |
363 |
(deftest defpackage-13 |
(deftest defpackage-13 |
364 |
(progn |
(progn |
365 |
(ignore-errors (delete-package "H")) |
(ignore-errors (delete-package "H")) |
366 |
(handler-case |
(classify-error |
367 |
(eval '(defpackage "H" (:use) (:size 10) (:size 20))) |
(eval '(defpackage "H" (:use) (:size 10) (:size 20))))) |
|
(program-error () 'program-error) |
|
|
(error (c) c))) |
|
368 |
program-error) |
program-error) |
369 |
|
|
370 |
;; Repeated documentation field should cause a program-error |
;; Repeated documentation field should cause a program-error |
371 |
(deftest defpackage-14 |
(deftest defpackage-14 |
372 |
(progn |
(progn |
373 |
(ignore-errors (delete-package "H")) |
(ignore-errors (delete-package "H")) |
374 |
(handler-case |
(classify-error |
375 |
(eval '(defpackage "H" (:use) |
(eval '(defpackage "H" (:use) |
376 |
(:documentation "foo") |
(:documentation "foo") |
377 |
(:documentation "bar"))) |
(:documentation "bar"))))) |
|
(program-error () 'program-error) |
|
|
(error (c) c))) |
|
378 |
program-error) |
program-error) |
379 |
|
|
380 |
;; When a nickname refers to an existing package or nickname, |
;; When a nickname refers to an existing package or nickname, |
383 |
(deftest defpackage-15 |
(deftest defpackage-15 |
384 |
(progn |
(progn |
385 |
(ignore-errors (delete-package "H")) |
(ignore-errors (delete-package "H")) |
386 |
(handler-case |
(classify-error |
387 |
(eval '(defpackage "H" (:use) |
(eval '(defpackage "H" (:use) |
388 |
(:nicknames "A"))) |
(:nicknames "A"))))) |
|
(package-error () 'package-error) |
|
|
(error (c) c))) |
|
389 |
package-error) |
package-error) |
390 |
|
|
391 |
(deftest defpackage-16 |
(deftest defpackage-16 |
392 |
(progn |
(progn |
393 |
(ignore-errors (delete-package "H")) |
(ignore-errors (delete-package "H")) |
394 |
(handler-case |
(classify-error |
395 |
(eval '(defpackage "H" (:use) |
(eval '(defpackage "H" (:use) |
396 |
(:nicknames "Q"))) |
(:nicknames "Q"))))) |
|
(package-error () 'package-error) |
|
|
(error (c) c))) |
|
397 |
package-error) |
package-error) |
398 |
|
|
399 |
;; Names in :shadow, :shadowing-import-from, :import-from, and :intern |
;; Names in :shadow, :shadowing-import-from, :import-from, and :intern |
401 |
|
|
402 |
;; :shadow and :shadowing-import-from |
;; :shadow and :shadowing-import-from |
403 |
(deftest defpackage-17 |
(deftest defpackage-17 |
404 |
(ignore-errors |
(progn |
405 |
(ignore-errors (delete-package "H")) |
(ignore-errors (delete-package "H")) |
406 |
(ignore-errors (delete-package "G")) |
(ignore-errors (delete-package "G")) |
407 |
(eval '(defpackage "G" (:use) (:export "A"))) |
(eval '(defpackage "G" (:use) (:export "A"))) |
408 |
(handler-case |
(classify-error |
409 |
(eval '(defpackage "H" (:use) |
(eval '(defpackage "H" (:use) |
410 |
(:shadow "A") |
(:shadow "A") |
411 |
(:shadowing-import-from "G" "A"))) |
(:shadowing-import-from "G" "A"))))) |
|
(program-error () 'program-error) |
|
|
(error (c) c))) |
|
412 |
program-error) |
program-error) |
413 |
|
|
414 |
;; :shadow and :import-from |
;; :shadow and :import-from |
415 |
(deftest defpackage-18 |
(deftest defpackage-18 |
416 |
(ignore-errors |
(progn |
417 |
(ignore-errors (delete-package "H")) |
(ignore-errors (delete-package "H")) |
418 |
(ignore-errors (delete-package "G")) |
(ignore-errors (delete-package "G")) |
419 |
(eval '(defpackage "G" (:use) (:export "A"))) |
(eval '(defpackage "G" (:use) (:export "A"))) |
420 |
(handler-case |
(classify-error |
421 |
(eval '(defpackage "H" (:use) |
(eval '(defpackage "H" (:use) |
422 |
(:shadow "A") |
(:shadow "A") |
423 |
(:import-from "G" "A"))) |
(:import-from "G" "A"))))) |
|
(program-error () 'program-error) |
|
|
(error (c) c))) |
|
424 |
program-error) |
program-error) |
425 |
|
|
426 |
;; :shadow and :intern |
;; :shadow and :intern |
427 |
(deftest defpackage-19 |
(deftest defpackage-19 |
428 |
(progn |
(progn |
429 |
(ignore-errors (delete-package "H")) |
(ignore-errors (delete-package "H")) |
430 |
(handler-case |
(classify-error |
431 |
(eval '(defpackage "H" (:use) |
(eval '(defpackage "H" (:use) |
432 |
(:shadow "A") |
(:shadow "A") |
433 |
(:intern "A"))) |
(:intern "A"))))) |
|
(program-error () 'program-error) |
|
|
(error (c) c))) |
|
434 |
program-error) |
program-error) |
435 |
|
|
436 |
;; :shadowing-import-from and :import-from |
;; :shadowing-import-from and :import-from |
437 |
(deftest defpackage-20 |
(deftest defpackage-20 |
438 |
(ignore-errors |
(progn |
439 |
(ignore-errors (delete-package "H")) |
(ignore-errors (delete-package "H")) |
440 |
(ignore-errors (delete-package "G")) |
(ignore-errors (delete-package "G")) |
441 |
(eval '(defpackage "G" (:use) (:export "A"))) |
(eval '(defpackage "G" (:use) (:export "A"))) |
442 |
(handler-case |
(classify-error |
443 |
(eval '(defpackage "H" (:use) |
(eval '(defpackage "H" (:use) |
444 |
(:shadowing-import-from "G" "A") |
(:shadowing-import-from "G" "A") |
445 |
(:import-from "G" "A"))) |
(:import-from "G" "A"))))) |
|
(program-error () 'program-error) |
|
|
(error (c) c))) |
|
446 |
program-error) |
program-error) |
447 |
|
|
448 |
;; :shadowing-import-from and :intern |
;; :shadowing-import-from and :intern |
449 |
(deftest defpackage-21 |
(deftest defpackage-21 |
450 |
(ignore-errors |
(progn |
451 |
(ignore-errors (delete-package "H")) |
(ignore-errors (delete-package "H")) |
452 |
(ignore-errors (delete-package "G")) |
(ignore-errors (delete-package "G")) |
453 |
(eval '(defpackage "G" (:use) (:export "A"))) |
(eval '(defpackage "G" (:use) (:export "A"))) |
454 |
(handler-case |
(classify-error |
455 |
(eval '(defpackage "H" (:use) |
(eval '(defpackage "H" (:use) |
456 |
(:shadowing-import-from "G" "A") |
(:shadowing-import-from "G" "A") |
457 |
(:intern "A"))) |
(:intern "A"))))) |
|
(program-error () 'program-error) |
|
|
(error (c) c))) |
|
458 |
program-error) |
program-error) |
459 |
|
|
460 |
;; :import-from and :intern |
;; :import-from and :intern |
461 |
(deftest defpackage-22 |
(deftest defpackage-22 |
462 |
(ignore-errors |
(progn |
463 |
(ignore-errors (delete-package "H")) |
(ignore-errors (delete-package "H")) |
464 |
(ignore-errors (delete-package "G")) |
(ignore-errors (delete-package "G")) |
465 |
(eval '(defpackage "G" (:use) (:export "A"))) |
(eval '(defpackage "G" (:use) (:export "A"))) |
466 |
(handler-case |
(classify-error |
467 |
(eval '(defpackage "H" (:use) |
(eval '(defpackage "H" (:use) |
468 |
(:import-from "G" "A") |
(:import-from "G" "A") |
469 |
(:intern "A"))) |
(:intern "A"))))) |
|
(program-error () 'program-error) |
|
|
(error (c) c))) |
|
470 |
program-error) |
program-error) |
471 |
|
|
472 |
;; Names given to :export and :intern must be disjoint, |
;; Names given to :export and :intern must be disjoint, |
473 |
;; otherwise signal a program-error |
;; otherwise signal a program-error |
474 |
(deftest defpackage-23 |
(deftest defpackage-23 |
475 |
(ignore-errors |
(progn |
476 |
(ignore-errors (delete-package "H")) |
(ignore-errors (delete-package "H")) |
477 |
(handler-case |
(classify-error |
478 |
(eval '(defpackage "H" (:use) |
(eval '(defpackage "H" (:use) |
479 |
(:export "A") |
(:export "A") |
480 |
(:intern "A"))) |
(:intern "A"))))) |
|
(program-error () 'program-error) |
|
|
(error (c) c))) |
|
481 |
program-error) |
program-error) |
482 |
|
|
483 |
;; :shadowing-import-from signals a correctable package-error |
;; :shadowing-import-from signals a correctable package-error |
484 |
;; if the symbol is not accessible in the named package |
;; if the symbol is not accessible in the named package |
485 |
(deftest defpackage-24 |
(deftest defpackage-24 |
486 |
(ignore-errors |
(progn |
487 |
(ignore-errors (delete-package "H")) |
(ignore-errors (delete-package "H")) |
488 |
(ignore-errors (delete-package "G")) |
(ignore-errors (delete-package "G")) |
489 |
(eval '(defpackage "G" (:use))) |
(eval '(defpackage "G" (:use))) |
490 |
(handler-case |
(handle-non-abort-restart |
491 |
(eval '(defpackage "H" (:shadowing-import-from "G" "NOT-THERE"))) |
(eval '(defpackage "H" (:shadowing-import-from |
492 |
(package-error (c) |
"G" "NOT-THERE"))))) |
|
(if (position 'abort (compute-restarts c) |
|
|
:key #'restart-name :test-not #'eq) |
|
|
'success |
|
|
'fail)) |
|
|
(error (c) c))) |
|
493 |
success) |
success) |
494 |
|
|
495 |
;; :import-from signals a correctable package-error if a symbol with |
;; :import-from signals a correctable package-error if a symbol with |
496 |
;; the indicated name is not accessible in the package indicated |
;; the indicated name is not accessible in the package indicated |
497 |
|
|
498 |
(deftest defpackage-25 |
(deftest defpackage-25 |
499 |
(ignore-errors |
(progn |
500 |
(ignore-errors (delete-package "H")) |
(ignore-errors (delete-package "H")) |
501 |
(ignore-errors (delete-package "G")) |
(ignore-errors (delete-package "G")) |
502 |
(eval '(defpackage "G" (:use))) |
(eval '(defpackage "G" (:use))) |
503 |
(handler-case |
(handle-non-abort-restart |
504 |
(eval '(defpackage "H" (:import-from "G" "NOT-THERE"))) |
(eval '(defpackage "H" (:import-from "G" "NOT-THERE"))))) |
|
(package-error (c) |
|
|
(if (position 'abort (compute-restarts c) |
|
|
:key #'restart-name :test-not #'eq) |
|
|
'success |
|
|
'fail)) |
|
|
(error (c) c))) |
|
505 |
success) |
success) |
506 |
|
|
507 |
;; A big test that combines all the options to defpackage |
;; A big test that combines all the options to defpackage |