59 |
;; Test defpackage with documentation option |
;; Test defpackage with documentation option |
60 |
;; Do not check use-list, because it is implementation dependent |
;; Do not check use-list, because it is implementation dependent |
61 |
(deftest defpackage.3 |
(deftest defpackage.3 |
62 |
(progn |
(let () |
63 |
(safely-delete-package "H") |
(safely-delete-package "H") |
64 |
(ignore-errors |
(ignore-errors |
65 |
(let ((p (eval '(defpackage "H" (:documentation "This is a doc string"))))) |
(let ((p (eval '(defpackage "H" (:documentation "This is a doc string"))))) |
104 |
|
|
105 |
;; Test defpackage shadow option, and null use |
;; Test defpackage shadow option, and null use |
106 |
(deftest defpackage.5 |
(deftest defpackage.5 |
107 |
(progn |
(let () |
108 |
(safely-delete-package "H") |
(safely-delete-package "H") |
109 |
(ignore-errors |
(ignore-errors |
110 |
(let ((p (ignore-errors (eval `(defpackage "H" (:use) |
(let ((p (ignore-errors (eval `(defpackage "H" (:use) |
329 |
;; Test defpackage with size |
;; Test defpackage with size |
330 |
|
|
331 |
(deftest defpackage.11 |
(deftest defpackage.11 |
332 |
(ignore-errors |
(let () |
333 |
(safely-delete-package "H") |
(ignore-errors |
334 |
(let ((p (ignore-errors |
(safely-delete-package "H") |
335 |
(eval '(defpackage "H" (:use) (:size 0)))))) |
(let ((p (ignore-errors |
336 |
(mapcar |
(eval '(defpackage "H" (:use) (:size 0)))))) |
337 |
#'notnot |
(mapcar |
338 |
(list |
#'notnot |
339 |
(packagep p) |
(list |
340 |
(equal (package-name p) "H") |
(packagep p) |
341 |
(equal (package-use-list p) nil) |
(equal (package-name p) "H") |
342 |
(equal (package-used-by-list p) nil) |
(equal (package-use-list p) nil) |
343 |
(equal (package-nicknames p) nil) |
(equal (package-used-by-list p) nil) |
344 |
(equal (package-shadowing-symbols p) nil) |
(equal (package-nicknames p) nil) |
345 |
(zerop (num-symbols-in-package p)))))) |
(equal (package-shadowing-symbols p) nil) |
346 |
|
(zerop (num-symbols-in-package p))))))) |
347 |
(t t t t t t t)) |
(t t t t t t t)) |
348 |
|
|
349 |
(deftest defpackage.12 |
(deftest defpackage.12 |
350 |
(ignore-errors |
(let () |
351 |
(safely-delete-package "H") |
(ignore-errors |
352 |
(let ((p (ignore-errors |
(safely-delete-package "H") |
353 |
(eval '(defpackage "H" (:use) (:size 10000)))))) |
(let ((p (ignore-errors |
354 |
(mapcar |
(eval '(defpackage "H" (:use) (:size 10000)))))) |
355 |
#'notnot |
(mapcar |
356 |
(list |
#'notnot |
357 |
(packagep p) |
(list |
358 |
(equal (package-name p) "H") |
(packagep p) |
359 |
(equal (package-use-list p) nil) |
(equal (package-name p) "H") |
360 |
(equal (package-used-by-list p) nil) |
(equal (package-use-list p) nil) |
361 |
(equal (package-nicknames p) nil) |
(equal (package-used-by-list p) nil) |
362 |
(equal (package-shadowing-symbols p) nil) |
(equal (package-nicknames p) nil) |
363 |
(zerop (num-symbols-in-package p)))))) |
(equal (package-shadowing-symbols p) nil) |
364 |
|
(zerop (num-symbols-in-package p))))))) |
365 |
(t t t t t t t)) |
(t t t t t t t)) |
366 |
|
|
367 |
;; defpackage error handling |
;; defpackage error handling |
514 |
;; A big test that combines all the options to defpackage |
;; A big test that combines all the options to defpackage |
515 |
|
|
516 |
(deftest defpackage.26 |
(deftest defpackage.26 |
517 |
(ignore-errors |
(let () |
518 |
(flet |
(ignore-errors |
519 |
((%do-it% |
(flet |
520 |
(args) |
((%do-it% |
521 |
(safely-delete-package "H") |
(args) |
522 |
(safely-delete-package "G1") |
(safely-delete-package "H") |
523 |
(safely-delete-package "G2") |
(safely-delete-package "G1") |
524 |
(safely-delete-package "G3") |
(safely-delete-package "G2") |
525 |
(let ((pg1 |
(safely-delete-package "G3") |
526 |
(progn |
(let ((pg1 |
527 |
(format t "Making G1...~%") |
(progn |
528 |
(eval '(defpackage "G1" |
(format t "Making G1...~%") |
529 |
(:use) |
(eval '(defpackage "G1" |
530 |
(:export "A" "B" "C") |
(:use) |
531 |
(:intern "D" "E" "F"))))) |
(:export "A" "B" "C") |
532 |
(pg2 |
(:intern "D" "E" "F"))))) |
533 |
(progn |
(pg2 |
534 |
(format t "Making G2...~%") |
(progn |
535 |
(eval '(defpackage "G2" |
(format t "Making G2...~%") |
536 |
(:use) |
(eval '(defpackage "G2" |
537 |
(:export "A" "D" "G") |
(:use) |
538 |
(:intern "E" "H" "I"))))) |
(:export "A" "D" "G") |
539 |
(pg3 |
(:intern "E" "H" "I"))))) |
540 |
(progn |
(pg3 |
541 |
(format t "Making G3...~%") |
(progn |
542 |
(eval '(defpackage "G3" |
(format t "Making G3...~%") |
543 |
(:use) |
(eval '(defpackage "G3" |
544 |
(:export "J" "K" "L") |
(:use) |
545 |
(:intern "M" "N" "O")))))) |
(:export "J" "K" "L") |
546 |
(let ((p (eval (list* 'defpackage "H" (copy-tree args))))) |
(:intern "M" "N" "O")))))) |
547 |
(prog |
(let ((p (eval (list* 'defpackage "H" (copy-tree args))))) |
548 |
() |
(prog |
549 |
(unless (packagep p) (return 1)) |
() |
550 |
(unless (equal (package-name p) "H") (return 2)) |
(unless (packagep p) (return 1)) |
551 |
(unless (equal (package-name pg1) "G1") (return 3)) |
(unless (equal (package-name p) "H") (return 2)) |
552 |
(unless (equal (package-name pg2) "G2") (return 4)) |
(unless (equal (package-name pg1) "G1") (return 3)) |
553 |
(unless (equal (package-name pg3) "G3") (return 5)) |
(unless (equal (package-name pg2) "G2") (return 4)) |
554 |
(unless |
(unless (equal (package-name pg3) "G3") (return 5)) |
555 |
(equal (sort (copy-list (package-nicknames p)) #'string<) |
(unless |
556 |
'("H1" "H2")) |
(equal (sort (copy-list (package-nicknames p)) #'string<) |
557 |
(return 6)) |
'("H1" "H2")) |
558 |
(unless |
(return 6)) |
|
(or |
|
|
(equal (package-use-list p) (list pg1 pg2)) |
|
|
(equal (package-use-list p) (list pg2 pg1))) |
|
|
(return 7)) |
|
|
(unless (equal (package-used-by-list pg1) (list p)) |
|
|
(return 8)) |
|
|
(unless (equal (package-used-by-list pg2) (list p)) |
|
|
(return 9)) |
|
|
(when (package-used-by-list pg3) (return 10)) |
|
|
(unless (equal (sort (mapcar #'symbol-name |
|
|
(package-shadowing-symbols p)) |
|
|
#'string<) |
|
|
'("A" "B")) |
|
|
(return 10)) |
|
|
(let ((num 11)) |
|
559 |
(unless |
(unless |
560 |
(every |
(or |
561 |
#'(lambda (str acc pkg) |
(equal (package-use-list p) (list pg1 pg2)) |
562 |
(multiple-value-bind* |
(equal (package-use-list p) (list pg2 pg1))) |
563 |
(sym access) |
(return 7)) |
564 |
(find-symbol str p) |
(unless (equal (package-used-by-list pg1) (list p)) |
565 |
(or |
(return 8)) |
566 |
(and (or (not acc) (equal (symbol-name sym) str)) |
(unless (equal (package-used-by-list pg2) (list p)) |
567 |
(or (not acc) (equal (symbol-package sym) pkg)) |
(return 9)) |
568 |
(equal access acc) |
(when (package-used-by-list pg3) (return 10)) |
569 |
(incf num)) |
(unless (equal (sort (mapcar #'symbol-name |
570 |
(progn |
(package-shadowing-symbols p)) |
571 |
(format t |
#'string<) |
572 |
"Failed on str = ~S, acc = ~S, pkg = ~S, sym = ~S, access = ~S~%" |
'("A" "B")) |
573 |
str acc pkg sym access) |
(return 10)) |
574 |
nil)))) |
(let ((num 11)) |
575 |
(list "A" "B" "C" "D" "E" "F" "G" |
(unless |
576 |
"H" "I" "J" "K" "L" "M" "N" "O") |
(every |
577 |
(list :internal :internal |
#'(lambda (str acc pkg) |
578 |
:external :inherited |
(multiple-value-bind* |
579 |
nil nil |
(sym access) |
580 |
:inherited :internal |
(find-symbol str p) |
581 |
nil nil |
(or |
582 |
nil :external |
(and (or (not acc) (equal (symbol-name sym) str)) |
583 |
nil nil |
(or (not acc) (equal (symbol-package sym) pkg)) |
584 |
:internal) |
(equal access acc) |
585 |
(list pg2 p pg1 pg2 nil nil |
(incf num)) |
586 |
pg2 p nil nil nil pg3 |
(progn |
587 |
nil nil pg3)) |
(format t |
588 |
(return num))) |
"Failed on str = ~S, acc = ~S, pkg = ~S, sym = ~S, access = ~S~%" |
589 |
(return 'success)))))) |
str acc pkg sym access) |
590 |
(let ((args '((:nicknames "H1" "H2") |
nil)))) |
591 |
(:use "G1" "G2") |
(list "A" "B" "C" "D" "E" "F" "G" |
592 |
(:shadow "B") |
"H" "I" "J" "K" "L" "M" "N" "O") |
593 |
(:shadowing-import-from "G2" "A") |
(list :internal :internal |
594 |
(:import-from "G3" "L" "O") |
:external :inherited |
595 |
(:intern "D" "H") |
nil nil |
596 |
(:export "L" "C") |
:inherited :internal |
597 |
(:size 20) |
nil nil |
598 |
(:documentation "A test package")))) |
nil :external |
599 |
(list (%do-it% args) |
nil nil |
600 |
(%do-it% (reverse args)))))) |
:internal) |
601 |
|
(list pg2 p pg1 pg2 nil nil |
602 |
|
pg2 p nil nil nil pg3 |
603 |
|
nil nil pg3)) |
604 |
|
(return num))) |
605 |
|
(return 'success)))))) |
606 |
|
(let ((args '((:nicknames "H1" "H2") |
607 |
|
(:use "G1" "G2") |
608 |
|
(:shadow "B") |
609 |
|
(:shadowing-import-from "G2" "A") |
610 |
|
(:import-from "G3" "L" "O") |
611 |
|
(:intern "D" "H") |
612 |
|
(:export "L" "C") |
613 |
|
(:size 20) |
614 |
|
(:documentation "A test package")))) |
615 |
|
(list (%do-it% args) |
616 |
|
(%do-it% (reverse args))))))) |
617 |
(success success)) |
(success success)) |
618 |
|
|
619 |
(def-macro-test defpackage.error.1 |
(def-macro-test defpackage.error.1 |