;; Copyright (C) 2002-2004, Yuji Minejima <ggb01164@nifty.ne.jp>
;; ALL RIGHTS RESERVED.
;;
;; $Id: must-package.lisp,v 1.11 2004/02/20 07:23:42 yuji Exp $
;; 
;; Redistribution and use in source and binary forms, with or without
;; modification, are permitted provided that the following conditions
;; are met:
;; 
;;  * Redistributions of source code must retain the above copyright
;;    notice, this list of conditions and the following disclaimer.
;;  * Redistributions in binary form must reproduce the above copyright
;;    notice, this list of conditions and the following disclaimer in
;;    the documentation and/or other materials provided with the
;;    distribution.
;; 
;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.


;; list-all-packages
(listp (list-all-packages))
(find "COMMON-LISP" (mapcar #'package-name (list-all-packages)) :test #'string=)
(find "COMMON-LISP-USER" (mapcar #'package-name (list-all-packages)) :test #'string=)
(find "KEYWORD" (mapcar #'package-name (list-all-packages)) :test #'string=)
(every #'packagep (list-all-packages))


;; find-package
(packagep (find-package "COMMON-LISP"))
(packagep (find-package "CL"))
(packagep (find-package "COMMON-LISP-USER"))
(packagep (find-package "CL-USER"))
(packagep (find-package "KEYWORD"))
(let ((cl (find-package "COMMON-LISP")))
  (eq cl (find-package cl)))
(eq (find-package "CL") (find-package "COMMON-LISP"))
(eq (find-package 'cl) (find-package "COMMON-LISP"))
(eq (find-package 'cl) (find-package 'common-lisp))
(let ((name "NO-SUCH-PACKAGE"))
  (when (find-package name)
    (delete-package name))
  (not (find-package name)))
(= (length (multiple-value-list (find-package "CL"))) 1)
(= (length (multiple-value-list (find-package "NO-SUCH-PACKAGE"))) 1)
(packagep (find-package (find-package (find-package "KEYWORD"))))


;; packagep
(every (complement #'packagep) '(nil a b "CL" "KEYWORD" (a) cl common-lisp-user))

;; make-package
(progn (when (find-package "a") (delete-package "a"))
       (and (packagep (make-package #\a)) (delete-package "a")))
(progn (when (find-package "a") (delete-package "a"))
       (and (packagep (make-package '|a|)) (delete-package "a")))
(progn (when (find-package "a") (delete-package "a"))
       (and (packagep (make-package "a")) (delete-package "a")))
(progn (when (find-package "a") (delete-package "a"))
       (and (packagep (make-package "a" :use nil)) (delete-package "a")))
(progn (when (find-package "a") (delete-package "a"))
       (and (packagep (make-package "a" :use '(cl))) (delete-package "a")))
(progn (when (find-package "a") (delete-package "a"))
       (and (packagep (make-package "a" :use '(cl) :nicknames '("b")))
            (delete-package "b")))
(progn (when (find-package "a") (delete-package "a"))
       (and (packagep (make-package "a" :use '(cl) :nicknames '("b" "c")))
            (delete-package "c")))
(progn (when (find-package "a") (delete-package "a"))
       (and (packagep (make-package "a" :use '(cl) :nicknames '(#\b "c")))
            (delete-package "b")))
(progn (when (find-package "a") (delete-package "a"))
       (and (packagep (make-package "a" :use '(cl) :nicknames '(|b| "c")))
            (delete-package "b")))
(HANDLER-CASE
    (PROGN
      (WHEN (FIND-PACKAGE "a") (DELETE-PACKAGE "a"))
      (WHEN (FIND-PACKAGE "b") (DELETE-PACKAGE "b"))
      (AND (PACKAGEP (MAKE-PACKAGE "b" :USE '(CL)))
           (PACKAGEP (MAKE-PACKAGE "a" :USE '(CL) :NICKNAMES '(|b| "c")))))
  (ERROR NIL T)
  (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
(HANDLER-CASE
    (PROGN
      (WHEN (FIND-PACKAGE "a") (DELETE-PACKAGE "a"))
      (WHEN (FIND-PACKAGE "b") (DELETE-PACKAGE "b"))
      (AND (PACKAGEP (MAKE-PACKAGE "a" :USE '(CL)))
           (PACKAGEP (MAKE-PACKAGE "a" :USE '(CL) :NICKNAMES '(|b| "c")))))
  (ERROR NIL T)
  (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
(HANDLER-CASE
    (PROGN
      (WHEN (FIND-PACKAGE "a") (DELETE-PACKAGE "a"))
      (WHEN (FIND-PACKAGE "d") (DELETE-PACKAGE "b"))
      (AND (PACKAGEP (MAKE-PACKAGE "a" :USE '(CL) :NICKNAMES '("b" "c")))
           (PACKAGEP (MAKE-PACKAGE "d" :USE '(CL) :NICKNAMES '("c")))))
  (ERROR NIL T)
  (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
(HANDLER-CASE
    (PROGN
      (WHEN (FIND-PACKAGE "TB-FOO") (DELETE-PACKAGE "TB-FOO"))
      (WHEN (FIND-PACKAGE "TB-BAR-TO-USE")
        (MAPCAN #'DELETE-PACKAGE (PACKAGE-USED-BY-LIST "TB-BAR-TO-USE"))
        (DELETE-PACKAGE "TB-BAR-TO-USE"))
      (AND (PACKAGEP (MAKE-PACKAGE "TB-BAR-TO-USE" :USE NIL))
           (EXPORT (INTERN "CAR" 'TB-BAR-TO-USE) 'TB-BAR-TO-USE)
           (MAKE-PACKAGE "TB-FOO" :USE '(CL "TB-BAR-TO-USE"))))
  (ERROR NIL T)
  (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))



;; package-name
(string= (package-name "COMMON-LISP") "COMMON-LISP")
(string= (package-name 'common-lisp) "COMMON-LISP")
(string= (package-name (find-package 'common-lisp)) "COMMON-LISP")
(string= (package-name "CL") "COMMON-LISP")
(string= (package-name 'cl) "COMMON-LISP")
(string= (package-name (find-package 'cl)) "COMMON-LISP")
(let ((designator-list
       (list 'cl 'common-lisp "CL" "COMMON-LISP" (find-package 'cl)
             'cl-user 'common-lisp-user "CL-USER" "COMMON-LISP-USER"
             (find-package 'cl-user)
             'keyword "KEYWORD" (find-package 'keyword))))
  (every #'stringp (mapcar #'package-name designator-list)))
(every #'stringp (mapcar #'package-name (list-all-packages)))
(let* ((name "TB-FOO")
       (package (or (find-package name) (make-package name :use nil))))
  (and (delete-package name)
       (not (find-package name))
       (null (package-name package))))


;; package-nicknames
(member "CL" (package-nicknames "COMMON-LISP") :test #'string=)
(member "CL" (package-nicknames 'common-lisp) :test #'string=)
(member "CL" (package-nicknames (find-package 'common-lisp)) :test #'string=)
(member "CL" (package-nicknames "CL") :test #'string=)
(member "CL" (package-nicknames 'cl) :test #'string=)
(member "CL" (package-nicknames (find-package 'cl)) :test #'string=)
(let ((name 'test-foo)
      (nicknames '(test-foo-nickname1 test-foo-nickname2 test-foo-nickname3)))
  (dolist (name (cons name nicknames))
    (when (find-package name) (delete-package name)))
  (every #'stringp (package-nicknames (make-package name :nicknames nicknames))))
(every #'stringp (mapcan #'(lambda (package)
                             (copy-list (package-nicknames package)))
                         (list-all-packages)))
(progn
  (when (find-package 'test-foo) (delete-package 'test-foo))
  (null (set-difference
         (package-nicknames (make-package 'test-foo
                                          :nicknames '("TB-FOO" "test-foo")))
         '("TB-FOO" "test-foo")
         :test #'string=)))
(let ((designator-list
       (list 'cl 'common-lisp "CL" "COMMON-LISP" (find-package 'cl)
             'cl-user 'common-lisp-user "CL-USER" "COMMON-LISP-USER"
             (find-package 'cl-user)
             'keyword "KEYWORD" (find-package 'keyword))))
  (every #'stringp (mapcan #'(lambda (designator)
                               (copy-list (package-nicknames designator)))
                           designator-list)))


;; package-shadowing-symbols
(every #'listp (mapcar #'package-shadowing-symbols (list-all-packages)))
(every #'symbolp (mapcan #'(lambda (package)
                             (copy-list (package-shadowing-symbols package)))
                         (list-all-packages)))
(listp (package-shadowing-symbols 'cl))
(listp (package-shadowing-symbols "CL-USER"))
(listp (package-shadowing-symbols "COMMON-LISP"))
(listp (package-shadowing-symbols (find-package 'keyword)))
(let ((designator-list
       (list 'cl 'common-lisp "CL" "COMMON-LISP" (find-package 'cl)
             'cl-user 'common-lisp-user "CL-USER" "COMMON-LISP-USER"
             (find-package 'cl-user)
             'keyword "KEYWORD" (find-package 'keyword))))
  (every #'symbolp (mapcan #'(lambda (designator)
                             (copy-list (package-shadowing-symbols designator)))
                           designator-list)))


;; package-use-list
(every #'listp (mapcar #'package-use-list (list-all-packages)))
(every #'packagep (mapcan #'(lambda (package)
                              (copy-list (package-use-list package)))
                          (list-all-packages)))
(listp (package-use-list 'cl))
(listp (package-use-list "CL-USER"))
(listp (package-use-list "COMMON-LISP"))
(listp (package-use-list (find-package 'keyword)))
(let ((designator-list
       (list 'cl 'common-lisp "CL" "COMMON-LISP" (find-package 'cl)
             'cl-user 'common-lisp-user "CL-USER" "COMMON-LISP-USER"
             (find-package 'cl-user)
             'keyword "KEYWORD" (find-package 'keyword))))
  (every #'packagep (mapcan #'(lambda (designator)
                                (copy-list (package-use-list designator)))
                            designator-list)))


;; package-used-by-list
(every #'listp (mapcar #'package-used-by-list (list-all-packages)))
(every #'packagep (mapcan #'(lambda (package)
                              (copy-list (package-used-by-list package)))
                          (list-all-packages)))
(listp (package-used-by-list 'cl))
(listp (package-used-by-list "CL-USER"))
(listp (package-used-by-list "COMMON-LISP"))
(listp (package-used-by-list (find-package 'keyword)))
(let ((designator-list
       (list 'cl 'common-lisp "CL" "COMMON-LISP" (find-package 'cl)
             'cl-user 'common-lisp-user "CL-USER" "COMMON-LISP-USER"
             (find-package 'cl-user)
             'keyword "KEYWORD" (find-package 'keyword))))
  (every #'packagep (mapcan #'(lambda (designator)
                                (copy-list (package-used-by-list designator)))
                            designator-list)))


;; rename-package
(progn
  (mapcar #'(lambda (package)
              (when (find-package package) (delete-package package)))
          '("TB-FOO" "TB-FOO-RENAMED"))
  (let* ((package (make-package "TB-FOO" :use nil)))
    (and (eq (rename-package "TB-FOO" "TB-FOO-RENAMED") package)
         (eq (find-package "TB-FOO-RENAMED") package))))
(progn
  (mapcar #'(lambda (package)
              (when (find-package package) (delete-package package)))
          '("TB-FOO-0" "TB-FOO-1" "TB-FOO-2" "TB-FOO-3" "TB-FOO-4"))
  (let* ((package (make-package "TB-FOO-0" :use nil)))
    (and (eq (rename-package "TB-FOO-0" "TB-FOO-1") package)
         (eq (rename-package "TB-FOO-1" "TB-FOO-2") package)
         (eq (rename-package "TB-FOO-2" "TB-FOO-3") package)
         (eq (rename-package "TB-FOO-3" "TB-FOO-4") package)
         (eq (find-package "TB-FOO-4") package))))
(progn
  (mapcar #'(lambda (package)
              (when (find-package package) (delete-package package)))
          '("TB-FOO-0" "TB-FOO-1" "TB-FOO-2" "TB-FOO-3" "TB-FOO-4"))
  (let* ((package (make-package "TB-FOO-0" :use nil)))
    (and (eq (rename-package (find-package "TB-FOO-0") "TB-FOO-1") package)
         (eq (rename-package (find-package "TB-FOO-1") "TB-FOO-2") package)
         (eq (rename-package (find-package "TB-FOO-2") "TB-FOO-3") package)
         (eq (rename-package (find-package "TB-FOO-3") "TB-FOO-4") package)
         (eq (find-package "TB-FOO-4") package))))
(progn
  (mapcar #'(lambda (package)
              (when (find-package package) (delete-package package)))
          '(#\a #\b))
  (let ((package (make-package #\a :use nil)))
    (and (eq (rename-package #\a #\b) package)
         (eq (find-package #\b) package)
         (string= (package-name package) #\b))))
(let ((name-list (list #\a 'b "TB-FOO-0" "TB-FOO-1" 'test-foo-2)))
  (mapcar #'(lambda (package)
              (when (find-package package) (delete-package package)))
          name-list)
  (let* ((old (pop name-list))
         (package (make-package old :use nil)))
    (dolist (new name-list t)
      (unless (eq (rename-package old new) package)
        (return nil))
      (setq old new))))
(progn
  (mapcar #'(lambda (package)
              (when (find-package package) (delete-package package)))
          '("TB-FOO" "TB-FOO-RENAMED"
            "TB-FOO-NICKNAME-0" "TB-FOO-NICKNAME-1"))
  (let* ((package (make-package "TB-FOO"
                                :use nil
                                :nicknames '("TB-FOO-NICKNAME-0"
                                             "TB-FOO-NICKNAME-1"))))
    (and (eq (rename-package "TB-FOO" "TB-FOO-RENAMED") package)
         (eq (find-package "TB-FOO-RENAMED") package)
         (null (set-difference (package-nicknames "TB-FOO-RENAMED")
                               '("TB-FOO-NICKNAME-0" "TB-FOO-NICKNAME-1")
                               :test #'string=)))))
(progn
  (mapcar #'(lambda (package)
              (when (find-package package) (delete-package package)))
          '("TB-FOO-0" "TB-FOO-1" "TB-FOO-2"
            "TB-FOO-3" "TB-FOO-4" "TB-FOO-5"))
  (let* ((package (make-package "TB-FOO-0"
                                :use nil
                                :nicknames '("TB-FOO-1" "TB-FOO-2"))))
    (and (eq (rename-package package "TB-FOO-3" '("TB-FOO-4" "TB-FOO-5"))
             package)
         (eq (find-package "TB-FOO-3") package)
         (eq (find-package "TB-FOO-4") package)
         (eq (find-package "TB-FOO-5") package)
         (not (every #'find-package
                     '("TB-FOO-0" "TB-FOO-1" "TB-FOO-2"))))))
(progn
  (mapcar #'(lambda (package)
              (when (find-package package) (delete-package package)))
          '("TB-FOO-0" "TB-FOO-1" "TB-FOO-2"))
  (let* ((package (make-package "TB-FOO-0" :use nil :nicknames '("TB-FOO-1"))))
    (eq (rename-package package "TB-FOO-1" '("TB-FOO-2")) package)))
(progn
  (mapcar #'(lambda (package)
              (when (find-package package) (delete-package package)))
          '("TB-FOO-0" "TB-FOO-1" "TB-FOO-2"
            "TB-FOO-3" "TB-FOO-4" "TB-FOO-5"))
  (let* ((package (make-package "TB-FOO-0" :use nil :nicknames '("TB-FOO-1"))))
    (and (eq (rename-package package "TB-FOO-1" '("TB-FOO-2")) package)
         (eq (rename-package package "TB-FOO-2" '("TB-FOO-3")) package)
         (eq (rename-package package "TB-FOO-3" '("TB-FOO-4")) package)
         (eq (rename-package package "TB-FOO-4" '("TB-FOO-5")) package)
         (eq (rename-package package "TB-FOO-5" '("TB-FOO-0")) package)
         (eq (find-package 'test-foo-5) (find-package 'test-foo-0)))))
(progn
  (mapcar #'(lambda (package)
              (when (find-package package) (delete-package package)))
          '("TB-FOO-0" "TB-FOO-1" "TB-FOO-2"))
  (let* ((package (make-package "TB-FOO-0" :use nil
                                :nicknames '("TB-FOO-1" "TB-FOO-2"))))
    (and (eq (rename-package package "TB-FOO-2" '("TB-FOO-3" "TB-FOO-1"))
             package)
         (string= (package-name package) "TB-FOO-2")
         (null (set-difference (package-nicknames package)
                               '("TB-FOO-3" "TB-FOO-1")
                               :test #'string=)))))
(progn
  (mapcar #'(lambda (package)
              (when (find-package package) (delete-package package)))
          '("TB-FOO-0" "TB-FOO-1" "TB-FOO-2"))
  (let* ((package (make-package "TB-FOO-0" :use nil
                                :nicknames '("TB-FOO-1" "TB-FOO-2"))))
    (and (eq (rename-package package "TB-FOO-3") package)
         (string= (package-name package) "TB-FOO-3")
         (null (package-nicknames package)))))


;; find-symbol
(equal (multiple-value-list (find-symbol "CAR" "CL")) '(cl:car :EXTERNAL))
(equal (multiple-value-list (find-symbol "CDR" "CL")) '(cl:cdr :EXTERNAL))
(equal (multiple-value-list (find-symbol "CDR" 'cl)) '(cl:cdr :EXTERNAL))
(equal (multiple-value-list (find-symbol "CDR" (find-package 'cl)))
       '(cl:cdr :EXTERNAL))
(equal (multiple-value-list (find-symbol "NIL" "CL")) '(nil :EXTERNAL))
(let ((*package* (find-package 'cl)))
  (equal (multiple-value-list (find-symbol "CDR")) '(cl:cdr :EXTERNAL)))
(progn
  (when (find-package "A") (delete-package "A"))
  (make-package "A" :use nil)
  (equal (multiple-value-list (find-symbol "A" #\A)) '(nil nil)))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (make-package "TB-FOO" :use nil)
  (equal (multiple-value-list (find-symbol "A" "TB-FOO")) '(nil nil)))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (make-package "TB-FOO" :use nil)
  (multiple-value-bind (symbol0 status0) (intern "A" "TB-FOO")
    (multiple-value-bind (symbol1 status1) (find-symbol "A" "TB-FOO")
      (and (eq symbol0 symbol1)
           (null status0)
           (eq status1 :internal)))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (make-package "TB-FOO" :use '("CL"))
  (equal (multiple-value-list (find-symbol "CAR" "TB-FOO"))
         '(cl:car :inherited)))
(do-external-symbols (symbol "CL" t)
  (multiple-value-bind (symbol-found status)
      (find-symbol (symbol-name symbol) "COMMON-LISP-USER")
    (unless (and (eq symbol symbol-found) (eq status :inherited))
      (error "Symbol ~S is ~S" symbol-found status))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (let ((*package* (make-package "TB-FOO" :use '("COMMON-LISP"))))
    (and (equal (multiple-value-list (find-symbol "APPEND"))
                '(cl:append :inherited))
         (equal (multiple-value-list (find-symbol "FIND"))
                '(cl:find :inherited))
         (equal (multiple-value-list (find-symbol "CAR"))
                '(cl:car :inherited)))))
(equal (multiple-value-list (find-symbol "NIL" 'cl)) '(nil :external))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (let* ((*package* (make-package "TB-FOO" :use (list 'cl)))
         (symbol (intern "car" *package*)))
    (and (equal (multiple-value-list (find-symbol "car"))
                (list symbol :internal))
         (equal (multiple-value-list (find-symbol "CAR"))
                (list 'cl:car :inherited)))))
           

;; find-all-symbols
(member 'cl:car (find-all-symbols 'car))
(member 'cl:cdr (find-all-symbols "CDR"))
(every #'symbolp (find-all-symbols "LOOP"))
(every #'(lambda (name) (string= name "FIND"))
       (mapcar #'symbol-name (find-all-symbols "FIND")))
(dolist (name (list "CAR" "CDR" #\a #\A 'common-lisp 'join "" "XXX" "aA"
                    "LONGLONGLONGLONGLONGLONGLONGLONGLONGLONG"
                    'long-long-long-long-long-long-name) t)
  (unless (every #'(lambda (symbol-name) (string= symbol-name name))
                 (mapcar #'symbol-name (find-all-symbols name)))
    (return nil)))


;; intern
(symbolp (intern "SYMBOL"))
(symbolp (intern "long-long-name-in-lower-case"))
(equal (multiple-value-list (intern "NIL" 'cl)) '(nil :external))
(multiple-value-bind (boo status) (intern "BOO")
  (and (symbolp boo)
       (member status '(nil :internal :external :inherited))
       (string= (symbol-name boo) "BOO")))
(let ((*package* (find-package "CL")))
  (equal (multiple-value-list (intern "CAR")) '(cl:car :external)))
(let ((*package* (find-package "KEYWORD")))
  (equal (multiple-value-list (intern "TEST")) '(:test :external)))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (make-package "TB-FOO" :use nil)
  (and (multiple-value-list (intern "BOO" 'tb-foo))
       (list (find-symbol "BOO" 'tb-foo) nil)
       (eq (symbol-package (find-symbol "BOO" 'tb-foo)) (find-package 'tb-foo))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (let ((*package* (make-package "TB-FOO" :use '(cl))))
    (and (eq (intern "CAR") 'cl:car)
         (equal (multiple-value-list (intern "ZZZ"))
                (list (find-symbol "ZZZ") nil))
         (equal (multiple-value-list (intern "ZZZ"))
                (list (find-symbol "ZZZ") :internal))
         (export (find-symbol "ZZZ"))
         (equal (multiple-value-list (intern "ZZZ"))
                (list (find-symbol "ZZZ") :external)))))

;; export
(eq (export ()) t)
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (let ((*package* (make-package "TB-FOO" :use nil))
        buz)
    (and (setq buz (intern "BUZ"))
         (equal (multiple-value-list (find-symbol "BUZ")) (list buz :internal))
         (eq (export buz) t)
         (equal (multiple-value-list (find-symbol "BUZ"))
                (list buz :external)))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (let ((*package* (make-package "TB-FOO" :use '(cl))))
    (and (equal (multiple-value-list (find-symbol "CAR")) '(cl:car :inherited))
         (eq (export 'cl:car) t)
         (equal (multiple-value-list (find-symbol "CAR")) '(cl:car :external)))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (let ((*package* (make-package "TB-FOO" :use '(cl))))
    (and (equal (multiple-value-list (find-symbol "CAR")) '(cl:car :inherited))
         (eq (export '(cl:car)) t)
         (equal (multiple-value-list (find-symbol "CAR")) '(cl:car :external)))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (let ((*package* (make-package "TB-FOO" :use '(cl))))
    (and (equal (multiple-value-list (find-symbol "CAR")) '(cl:car :inherited))
         (equal (multiple-value-list (find-symbol "CDR")) '(cl:cdr :inherited))
         (eq (export '(cl:car cl:cdr)) t)
         (equal (multiple-value-list (find-symbol "CAR")) '(cl:car :external))
         (equal (multiple-value-list (find-symbol "CDR")) '(cl:cdr :external)))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (let ((*package* (make-package "TB-FOO" :use '(cl)))
        (buz (make-symbol "BUZ")))
    (import buz)
    (and (equal (multiple-value-list (find-symbol "CAR")) '(cl:car :inherited))
         (equal (multiple-value-list (find-symbol "CDR")) '(cl:cdr :inherited))
         (equal (multiple-value-list (find-symbol "BUZ")) (list buz :internal))
         (eq (export (list 'cl:car buz 'cl:cdr)) t)
         (equal (multiple-value-list (find-symbol "CAR")) '(cl:car :external))
         (equal (multiple-value-list (find-symbol "CDR")) '(cl:cdr :external))
         (equal (multiple-value-list (find-symbol "BUZ"))
                (list buz :external)))))
(progn
  (when (find-package "A") (delete-package "A"))
  (make-package "A" :use nil)
  (import 'cl:car "A")
  (and (eq (export 'cl:car "A") t)
       (equal (multiple-value-list (find-symbol "CAR" "A"))
              '(cl:car :external))))
(progn
  (when (find-package "A") (delete-package "A"))
  (make-package "A" :use nil)
  (import 'cl:car "A")
  (and (eq (export 'cl:car #\A) t)
       (equal (multiple-value-list (find-symbol "CAR" "A"))
              '(cl:car :external))))
(progn
  (when (find-package "A") (delete-package "A"))
  (make-package "A" :use nil)
  (import 'cl:car "A")
  (and (eq (export 'cl:car 'a) t)
       (equal (multiple-value-list (find-symbol "CAR" "A"))
              '(cl:car :external))))
(progn
  (when (find-package "A") (delete-package "A"))
  (make-package "A" :use nil)
  (import 'cl:car "A")
  (and (eq (export 'cl:car (find-package 'a)) t)
       (equal (multiple-value-list (find-symbol "CAR" "A"))
              '(cl:car :external))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (let ((*package* (make-package "TB-FOO" :use '(cl))))
    (and (equal (multiple-value-list (find-symbol "CAR")) '(cl:car :inherited))
         (eq (export 'cl:car) t)
         (equal (multiple-value-list (find-symbol "CAR")) '(cl:car :external))
         (unuse-package 'cl)
         (equal (multiple-value-list (find-symbol "CAR")) '(cl:car :external)))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (when (find-package "TB-BAR-TO-USE")
    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
    (delete-package "TB-BAR-TO-USE"))
  (make-package "TB-BAR-TO-USE" :use nil)
  (make-package "TB-FOO" :use '("TB-BAR-TO-USE"))
  (let ((buz (intern "BUZ" 'tb-bar-to-use)))
    (and (equal (multiple-value-list (find-symbol "BUZ" 'tb-foo)) '(nil nil))
         (export buz 'tb-bar-to-use)
         (equal (multiple-value-list (find-symbol "BUZ" 'tb-foo))
                (list buz :inherited)))))
(HANDLER-CASE
    (PROGN
      (WHEN (FIND-PACKAGE "TB-FOO") (DELETE-PACKAGE "TB-FOO"))
      (MAKE-PACKAGE "TB-FOO" :USE NIL)
      (EXPORT 'CAR "TB-FOO"))
 (PACKAGE-ERROR NIL T)
 (ERROR NIL NIL)
 (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
(HANDLER-CASE
    (PROGN
      (WHEN (FIND-PACKAGE "TB-FOO") (DELETE-PACKAGE "TB-FOO"))
      (WHEN (FIND-PACKAGE "TB-BAR-TO-USE")
        (MAPCAN #'DELETE-PACKAGE (PACKAGE-USED-BY-LIST "TB-BAR-TO-USE"))
        (DELETE-PACKAGE "TB-BAR-TO-USE"))
      (MAKE-PACKAGE "TB-BAR-TO-USE" :USE NIL)
      (MAKE-PACKAGE "TB-FOO" :USE '("TB-BAR-TO-USE"))
      (INTERN "BUZ" 'TB-FOO)
      (LET ((BUZ (INTERN "BUZ" 'TB-BAR-TO-USE)))
        (EXPORT BUZ 'TB-BAR-TO-USE)))
 (PACKAGE-ERROR NIL T)
 (ERROR NIL NIL)
 (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))


;; unexport
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (let ((*package* (make-package "TB-FOO" :use nil))
        buz)
    (and (export (setq buz (intern "BUZ")))
         (equal (multiple-value-list (find-symbol "BUZ")) (list buz :external))
         (eq (unexport buz) t)
         (equal (multiple-value-list (find-symbol "BUZ"))
                (list buz :internal)))))
(progn
  (when (find-package "A") (delete-package "A"))
  (make-package "A" :use nil)
  (let (buz)
    (and (export (setq buz (intern "BUZ" 'a)) 'a)
         (equal (multiple-value-list (find-symbol "BUZ" 'a))
                (list buz :external))
         (eq (unexport buz 'a) t)
         (equal (multiple-value-list (find-symbol "BUZ" 'a))
                (list buz :internal)))))
(progn
  (when (find-package "A") (delete-package "A"))
  (make-package "A" :use nil)
  (let (buz)
    (and (export (setq buz (intern "BUZ" 'a)) 'a)
         (equal (multiple-value-list (find-symbol "BUZ" 'a))
                (list buz :external))
         (eq (unexport buz #\A) t)
         (equal (multiple-value-list (find-symbol "BUZ" 'a))
                (list buz :internal)))))
(progn
  (when (find-package "A") (delete-package "A"))
  (make-package "A" :use nil)
  (let (buz)
    (and (export (setq buz (intern "BUZ" 'a)) 'a)
         (equal (multiple-value-list (find-symbol "BUZ" 'a))
                (list buz :external))
         (eq (unexport buz "A") t)
         (equal (multiple-value-list (find-symbol "BUZ" 'a))
                (list buz :internal)))))
(progn
  (when (find-package "A") (delete-package "A"))
  (make-package "A" :use nil)
  (let (buz)
    (and (export (setq buz (intern "BUZ" 'a)) 'a)
         (equal (multiple-value-list (find-symbol "BUZ" 'a))
                (list buz :external))
         (eq (unexport buz (find-package "A")) t)
         (equal (multiple-value-list (find-symbol "BUZ" 'a))
                (list buz :internal)))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (make-package "TB-FOO" :use nil)
  (let (buz)
    (and (export (setq buz (intern "BUZ" 'tb-foo)) 'tb-foo)
         (equal (multiple-value-list (find-symbol "BUZ" 'tb-foo))
                (list buz :external))
         (eq (unexport buz 'tb-foo) t)
         (equal (multiple-value-list (find-symbol "BUZ" 'tb-foo))
                (list buz :internal)))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (let* ((*package* (make-package "TB-FOO" :use nil))
         (names '("A" "BC" "DEF" "GHIJ"))
         (symbols (mapcar #'intern names)))
    (and (export symbols)
         (eq (unexport symbols) t)
         (every #'(lambda (status) (eq status :internal))
                (mapcar #'(lambda (name)
                            (cadr (multiple-value-list (find-symbol name))))
                        names)))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (let* ((*package* (make-package "TB-FOO" :use nil)))
    (import '(cl:nil))
    (export '(cl:nil))
    (and (eq (unexport 'cl:nil) t)
         (equal (multiple-value-list (find-symbol "NIL")) '(cl:nil :external)))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (let* ((*package* (make-package "TB-FOO" :use nil)))
    (import '(cl:nil))
    (export '(cl:nil))
    (and (eq (unexport '(cl:nil)) t)
         (equal (multiple-value-list (find-symbol "NIL")) '(nil :internal)))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (let* ((*package* (make-package "TB-FOO" :use nil))
         (baz (intern "BAZ" *package*)))
    (and
     (equal (multiple-value-list (find-symbol "BAZ")) (list baz :internal))
     (eq (unexport (list baz) *package*) t)
     (equal (multiple-value-list (find-symbol "BAZ")) (list baz :internal)))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (let* ((*package* (make-package "TB-FOO" :use nil))
         (baz (intern "BAZ" *package*))
         (woo (intern "WOO" *package*)))
    (export woo)
    (and
     (equal (multiple-value-list (find-symbol "BAZ")) (list baz :internal))
     (equal (multiple-value-list (find-symbol "WOO")) (list woo :external))
     (eq (unexport (list baz woo) *package*) t)
     (equal (multiple-value-list (find-symbol "BAZ")) (list baz :internal))
     (equal (multiple-value-list (find-symbol "WOO")) (list woo :internal)))))
(HANDLER-CASE
    (PROGN
      (WHEN (FIND-PACKAGE "TB-FOO") (DELETE-PACKAGE "TB-FOO"))
      (LET* ((*PACKAGE* (MAKE-PACKAGE "TB-FOO" :USE NIL)))
        (UNEXPORT 'CAR)))
  (PACKAGE-ERROR NIL T)
  (ERROR NIL NIL)
  (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
(HANDLER-CASE
    (PROGN
      (WHEN (FIND-PACKAGE "TB-FOO") (DELETE-PACKAGE "TB-FOO"))
      (LET* ((*PACKAGE* (MAKE-PACKAGE "TB-FOO" :USE NIL))
             (BAZ (INTERN "BAZ" *PACKAGE*))
             (WOO (INTERN "WOO" *PACKAGE*)))
        (EXPORT WOO)
        (UNEXPORT (LIST BAZ 'NIL WOO) *PACKAGE*)))
  (PACKAGE-ERROR NIL T)
  (ERROR NIL NIL)
  (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))




;; shadow
(eq (shadow '()) t)
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (make-package "TB-FOO" :use nil)
  (and (eq (shadow "A" 'tb-foo) t)
       (eq (cadr (multiple-value-list (find-symbol "A" 'tb-foo))) :internal)
       (equal (package-shadowing-symbols 'tb-foo)
              (list (find-symbol "A" 'tb-foo)))))
(eq (shadow '()) t)
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (make-package "TB-FOO" :use nil)
  (and (eq (shadow #\A 'tb-foo) t)
       (eq (cadr (multiple-value-list (find-symbol "A" 'tb-foo))) :internal)
       (equal (package-shadowing-symbols 'tb-foo)
              (list (find-symbol "A" 'tb-foo)))))
(eq (shadow '()) t)
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (make-package "TB-FOO" :use nil)
  (and (eq (shadow 'a 'tb-foo) t)
       (eq (cadr (multiple-value-list (find-symbol "A" 'tb-foo))) :internal)
       (equal (package-shadowing-symbols 'tb-foo)
              (list (find-symbol "A" 'tb-foo)))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (make-package "TB-FOO" :use nil)
  (and (eq (shadow '(a) 'tb-foo) t)
       (eq (cadr (multiple-value-list (find-symbol "A" 'tb-foo))) :internal)
       (equal (package-shadowing-symbols 'tb-foo)
              (list (find-symbol "A" 'tb-foo)))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (make-package "TB-FOO" :use nil)
  (and (eq (shadow '("A") 'tb-foo) t)
       (eq (cadr (multiple-value-list (find-symbol "A" 'tb-foo))) :internal)
       (equal (package-shadowing-symbols 'tb-foo)
              (list (find-symbol "A" 'tb-foo)))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (make-package "TB-FOO" :use nil)
  (and (eq (shadow '(#\A) 'tb-foo) t)
       (eq (cadr (multiple-value-list (find-symbol "A" 'tb-foo))) :internal)
       (equal (package-shadowing-symbols 'tb-foo)
              (list (find-symbol "A" 'tb-foo)))))
(progn
  (when (find-package "A") (delete-package "A"))
  (make-package "A" :use nil)
  (and (eq (shadow "BUZ" #\A) t)
       (eq (cadr (multiple-value-list (find-symbol "BUZ" 'a))) :internal)
       (equal (package-shadowing-symbols 'a)
              (list (find-symbol "BUZ" 'a)))))
(progn
  (when (find-package "A") (delete-package "A"))
  (make-package "A" :use nil)
  (and (eq (shadow "BUZ" "A") t)
       (eq (cadr (multiple-value-list (find-symbol "BUZ" 'a))) :internal)
       (equal (package-shadowing-symbols 'a)
              (list (find-symbol "BUZ" 'a)))))
(progn
  (when (find-package "A") (delete-package "A"))
  (make-package "A" :use nil)
  (and (eq (shadow "BUZ" 'a) t)
       (eq (cadr (multiple-value-list (find-symbol "BUZ" 'a))) :internal)
       (equal (package-shadowing-symbols 'a)
              (list (find-symbol "BUZ" 'a)))))
(progn
  (when (find-package "A") (delete-package "A"))
  (make-package "A" :use nil)
  (and (eq (shadow "BUZ" (find-package 'a)) t)
       (eq (cadr (multiple-value-list (find-symbol "BUZ" 'a))) :internal)
       (equal (package-shadowing-symbols 'a)
              (list (find-symbol "BUZ" 'a)))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (let ((*package* (make-package "TB-FOO" :use nil))
        (names '(a #\B "C" "BUZ")))
    (and (eq (shadow names) t)
         (every #'(lambda (name)
                    (eq (cadr (multiple-value-list (find-symbol name)))
                        :internal))
                names)
         (null (set-difference (mapcar #'find-symbol (mapcar #'string names))
                               (package-shadowing-symbols *package*))))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (let ((*package* (make-package "TB-FOO" :use '(cl)))
        (names '(a #\B "C" "BUZ" "CAR"))
        a b c)
    (setq a (intern "A"))
    (export (setq b (intern "B")))
    (shadowing-import (setq c (intern "C")))
    (and (eq (shadow names) t)
         (equal (multiple-value-list (find-symbol "A")) (list a :internal))
         (equal (multiple-value-list (find-symbol "B")) (list b :external))
         (equal (multiple-value-list (find-symbol "C")) (list c :internal))
         (eq (cadr (multiple-value-list (find-symbol "BUZ"))) :internal)
         (eq (cadr (multiple-value-list (find-symbol "CAR"))) :internal)
         (not (eq (car (multiple-value-list (find-symbol "CAR"))) 'cl:car))
         (null (set-difference (mapcar #'find-symbol (mapcar #'string names))
                               (package-shadowing-symbols *package*))))))




;; shadowing-import
(eq (shadowing-import '()) t)
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (shadowing-import '() (make-package "TB-FOO" :use nil))
  (let ((list nil))
    (null (do-symbols (symbol "TB-FOO" list) (push symbol list)))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (let ((*package* (make-package "TB-FOO" :use nil)))
    (and (not (find-symbol "CAR"))
         (not (find-symbol "CDR"))
         (not (find-symbol "LIST"))
         (eq (shadowing-import '(cl:car cl:cdr cl:list)) t)
         (eq (find-symbol "CAR") 'cl:car)
         (eq (find-symbol "CDR") 'cl:cdr)
         (eq (find-symbol "LIST") 'cl:list))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (let* ((*package* (make-package "TB-FOO" :use (list 'cl)))
         (names '("CAR" "CDR" "LIST" "APPEND"))
         (symbols (mapcar #'make-symbol names)))
    (and (eq (shadowing-import symbols) t)
         (every #'eq symbols (mapcar #'find-symbol names))
         (every #'(lambda (symbol)
                    (member symbol (package-shadowing-symbols *package*)))
                symbols))))
(progn
  (when (find-package "A") (delete-package "A"))
  (make-package "A" :use nil)
  (let ((symbol (make-symbol "CAR")))
    (and (eq (shadowing-import symbol "A") t)
         (equal (multiple-value-list (find-symbol "CAR" "A"))
                (list symbol :internal)))))
(progn
  (when (find-package "A") (delete-package "A"))
  (make-package "A" :use nil)
  (let ((symbol (make-symbol "CAR")))
    (and (eq (shadowing-import symbol #\A) t)
         (equal (multiple-value-list (find-symbol "CAR" "A"))
                (list symbol :internal)))))
(progn
  (when (find-package "A") (delete-package "A"))
  (make-package "A" :use nil)
  (let ((symbol (make-symbol "CAR")))
    (and (eq (shadowing-import symbol 'a) t)
         (equal (multiple-value-list (find-symbol "CAR" "A"))
                (list symbol :internal)))))
(progn
  (when (find-package "A") (delete-package "A"))
  (make-package "A" :use nil)
  (let ((symbol (make-symbol "CAR")))
    (and (eq (shadowing-import symbol (find-package 'a)) t)
         (equal (multiple-value-list (find-symbol "CAR" "A"))
                (list symbol :internal)))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (make-package "TB-FOO" :use nil)
  (let ((buz0 (intern "BUZ" 'tb-foo))
        (buz1 (make-symbol "BUZ")))
    (and (equal (multiple-value-list (find-symbol "BUZ" 'tb-foo))
                (list buz0 :internal))
         (eq (shadowing-import buz1 'tb-foo) t)

         (equal (multiple-value-list (find-symbol "BUZ" 'tb-foo))
                (list buz1 :internal))
         (equal (list buz1) (package-shadowing-symbols 'tb-foo))
         (unintern buz1 'tb-foo)
         (equal (multiple-value-list (find-symbol "BUZ" 'tb-foo)) '(nil nil))
         (null (package-shadowing-symbols 'tb-foo)))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (make-package "TB-FOO" :use nil)
  (let ((buz0 (intern "BUZ" 'tb-foo))
        (buz1 (make-symbol "BUZ")))
    (shadow buz0 'tb-foo)
    (and (equal (multiple-value-list (find-symbol "BUZ" 'tb-foo))
                (list buz0 :internal))
         (eq (shadowing-import buz1 'tb-foo) t)

         (equal (multiple-value-list (find-symbol "BUZ" 'tb-foo))
                (list buz1 :internal))
         (equal (list buz1) (package-shadowing-symbols 'tb-foo))
         (unintern buz1 'tb-foo)
         (equal (multiple-value-list (find-symbol "BUZ" 'tb-foo)) '(nil nil))
         (null (package-shadowing-symbols 'tb-foo)))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (make-package "TB-FOO" :use nil)
  (let ((buz0 (intern "BUZ" 'tb-foo))
        (buz1 (make-symbol "BUZ")))
    (export buz0 'tb-foo)
    (and (equal (multiple-value-list (find-symbol "BUZ" 'tb-foo))
                (list buz0 :external))
         (eq (shadowing-import buz1 'tb-foo) t)

         (equal (multiple-value-list (find-symbol "BUZ" 'tb-foo))
                (list buz1 :internal))
         (equal (list buz1) (package-shadowing-symbols 'tb-foo))
         (unintern buz1 'tb-foo)
         (equal (multiple-value-list (find-symbol "BUZ" 'tb-foo)) '(nil nil))
         (null (package-shadowing-symbols 'tb-foo)))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (make-package "TB-FOO" :use nil)
  (let ((buz0 (intern "BUZ" 'tb-foo))
        (buz1 (make-symbol "BUZ")))
    (export buz0 'tb-foo)
    (shadow buz0 'tb-foo)
    (and (equal (multiple-value-list (find-symbol "BUZ" 'tb-foo))
                (list buz0 :external))
         (eq (shadowing-import buz1 'tb-foo) t)
         (equal (multiple-value-list (find-symbol "BUZ" 'tb-foo))
                (list buz1 :internal))
         (equal (list buz1) (package-shadowing-symbols 'tb-foo))
         (unintern buz1 'tb-foo)
         (equal (multiple-value-list (find-symbol "BUZ" 'tb-foo)) '(nil nil))
         (null (package-shadowing-symbols 'tb-foo)))))



;; import
(eq (import '()) t)
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (make-package "TB-FOO" :use nil)
  (let ((list nil))
    (and (eq (import '() "TB-FOO") t)
         (null (do-symbols (symbol "TB-FOO" list) (push symbol list))))))
(progn
  (when (find-package "A") (delete-package "A"))
  (make-package "A" :use nil)
  (and (not (find-symbol "CAR" 'a))
       (eq (import 'cl:car 'a) t)
       (equal (multiple-value-list (find-symbol "CAR" 'a)) '(cl:car :internal))))
(progn
  (when (find-package "A") (delete-package "A"))
  (make-package "A" :use nil)
  (and (not (find-symbol "CAR" 'a))
       (eq (import 'cl:car #\A) t)
       (equal (multiple-value-list (find-symbol "CAR" 'a)) '(cl:car :internal))))
(progn
  (when (find-package "A") (delete-package "A"))
  (make-package "A" :use nil)
  (and (not (find-symbol "CAR" 'a))
       (eq (import 'cl:car "A") t)
       (equal (multiple-value-list (find-symbol "CAR" 'a)) '(cl:car :internal))))
(progn
  (when (find-package "A") (delete-package "A"))
  (make-package "A" :use nil)
  (and (not (find-symbol "CAR" 'a))
       (eq (import 'cl:car (find-package "A")) t)
       (equal (multiple-value-list (find-symbol "CAR" 'a)) '(cl:car :internal))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (make-package "TB-FOO" :use nil)
  (and (not (find-symbol "CAR" 'tb-foo))
       (eq (import 'cl:car 'tb-foo) t)
       (equal (multiple-value-list (find-symbol "CAR" 'tb-foo))
              '(cl:car :internal))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (make-package "TB-FOO" :use nil)
  (and (not (find-symbol "CAR" 'tb-foo))
       (eq (import (list 'cl:car 'cl:cdr 'cl:list :test) 'tb-foo) t)
       (equal (multiple-value-list (find-symbol "CAR" 'tb-foo))
              '(cl:car :internal))
       (equal (multiple-value-list (find-symbol "CDR" 'tb-foo))
              '(cl:cdr :internal))
       (equal (multiple-value-list (find-symbol "TEST" 'tb-foo))
              '(:test :internal))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (let ((*package* (make-package "TB-FOO" :use nil)))
    (and (not (find-symbol "CAR" 'tb-foo))
         (eq (import (list 'cl:car 'cl:cdr 'cl:list :test)) t)
         (equal (multiple-value-list (find-symbol "CAR" 'tb-foo))
                '(cl:car :internal))
         (equal (multiple-value-list (find-symbol "CDR" 'tb-foo))
                '(cl:cdr :internal))
         (equal (multiple-value-list (find-symbol "TEST" 'tb-foo))
                '(:test :internal)))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (let (buz)
    (make-package "TB-FOO" :use nil)
    (and (export (setq buz (intern "BUZ" "TB-FOO")) "TB-FOO")
         (equal (multiple-value-list (find-symbol "BUZ" "TB-FOO"))
                (list buz :external))
         (eq (import buz "TB-FOO") t)
         (equal (multiple-value-list (find-symbol "BUZ" "TB-FOO"))
                (list buz :external)))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (let (buz)
    (make-package "TB-FOO" :use nil)
    (and (setq buz (intern "BUZ" "TB-FOO"))
         (equal (multiple-value-list (find-symbol "BUZ" "TB-FOO"))
                (list buz :internal))
         (eq (import buz "TB-FOO") t)
         (equal (multiple-value-list (find-symbol "BUZ" "TB-FOO"))
                (list buz :internal)))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (let ((*package* (make-package "TB-FOO" :use '(cl))))
    (and (equal (multiple-value-list (find-symbol "CAR")) '(cl:car :inherited))
         (eq (import 'cl:car) t)
         (equal (multiple-value-list (find-symbol "CAR")) '(cl:car :internal)))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (make-package "TB-FOO" :use nil)
  (let ((buz (make-symbol "BUZ")))
    (and (null (symbol-package buz))
         (eq (import buz 'tb-foo) t)
         (eq (symbol-package buz) (find-package 'tb-foo)))))
(HANDLER-CASE
    (PROGN
      (WHEN (FIND-PACKAGE "TB-FOO") (DELETE-PACKAGE "TB-FOO"))
      (LET ((*PACKAGE* (MAKE-PACKAGE "TB-FOO" :USE '(CL))))
        (IMPORT (MAKE-SYMBOL "CAR"))))
 (PACKAGE-ERROR NIL T)
 (ERROR NIL NIL)
 (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
(HANDLER-CASE
    (PROGN
      (WHEN (FIND-PACKAGE "TB-FOO") (DELETE-PACKAGE "TB-FOO"))
      (LET ((*PACKAGE* (MAKE-PACKAGE "TB-FOO" :USE NIL)))
        (INTERN "BUZ")
        (IMPORT (MAKE-SYMBOL "BUZ"))))
  (PACKAGE-ERROR NIL T)
  (ERROR NIL NIL)
  (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
(HANDLER-CASE
    (PROGN
      (WHEN (FIND-PACKAGE "TB-FOO") (DELETE-PACKAGE "TB-FOO"))
      (LET ((*PACKAGE* (MAKE-PACKAGE "TB-FOO" :USE NIL)))
        (EXPORT (INTERN "BUZ"))
        (IMPORT (MAKE-SYMBOL "BUZ"))))
  (PACKAGE-ERROR NIL T)
  (ERROR NIL NIL)
  (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
(HANDLER-CASE
    (PROGN
      (WHEN (FIND-PACKAGE "TB-FOO") (DELETE-PACKAGE "TB-FOO"))
      (LET ((*PACKAGE* (MAKE-PACKAGE "TB-FOO" :USE NIL)))
        (SHADOWING-IMPORT (MAKE-SYMBOL "BUZ"))
        (IMPORT (MAKE-SYMBOL "BUZ"))))
  (PACKAGE-ERROR NIL T)
  (ERROR NIL NIL)
  (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))



;; unintern
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (make-package "TB-FOO" :use nil)
  (not (unintern 'cl:car "TB-FOO")))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (make-package "TB-FOO" :use nil)
  (and (unintern (intern "BUZ" "TB-FOO") "TB-FOO")
       (not (find-symbol "BUZ" "TB-FOO"))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (let ((*package* (make-package "TB-FOO" :use nil)))
    (not (unintern 'cl:car))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (let ((*package* (make-package "TB-FOO" :use nil)))
    (and (unintern (intern "BUZ"))
         (not (find-symbol "BUZ")))))
(progn
  (when (find-package "A") (delete-package "A"))
  (make-package "A" :use nil)
  (and (unintern (intern "BUZ" "A") #\A)
       (not (find-symbol "BUZ" "A"))))
(progn
  (when (find-package "A") (delete-package "A"))
  (make-package "A" :use nil)
  (and (unintern (intern "BUZ" "A") "A")
       (not (find-symbol "BUZ" "A"))))
(progn
  (when (find-package "A") (delete-package "A"))
  (make-package "A" :use nil)
  (and (unintern (intern "BUZ" "A") 'a)
       (not (find-symbol "BUZ" "A"))))
(progn
  (when (find-package "A") (delete-package "A"))
  (make-package "A" :use nil)
  (and (unintern (intern "BUZ" "A") (find-package 'a))
       (not (find-symbol "BUZ" "A"))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (let ((*package* (make-package "TB-FOO" :use '(cl))))
    (and (equal (multiple-value-list (find-symbol "CAR")) '(cl:car :inherited))
         (not (unintern 'cl:car)))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (let ((*package* (make-package "TB-FOO" :use nil)))
    (and (import 'cl:car)
         (equal (multiple-value-list (find-symbol "CAR")) '(cl:car :internal))
         (unintern 'cl:car)
         (not (find-symbol "CAR")))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (let ((*package* (make-package "TB-FOO" :use '(cl))))
    (and (equal (multiple-value-list (find-symbol "CAR")) '(cl:car :inherited))
         (import 'cl:car)
         (equal (multiple-value-list (find-symbol "CAR")) '(cl:car :internal))
         (unintern 'cl:car)
         (equal (multiple-value-list (find-symbol "CAR"))
                '(cl:car :inherited)))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (let ((*package* (make-package "TB-FOO" :use nil))
        (buz (make-symbol "BUZ")))
    (and (null (symbol-package buz))
         (import buz)
         (shadow buz)
         (eq (symbol-package buz) *package*)
         (member buz (package-shadowing-symbols *package*))
         (unintern buz)
         (not (find-symbol "BUZ"))
         (not (member buz (package-shadowing-symbols *package*)))
         (null (symbol-package buz)))))
(HANDLER-CASE
    (PROGN
      (WHEN (FIND-PACKAGE "TB-FOO") (DELETE-PACKAGE "TB-FOO"))
      (WHEN (FIND-PACKAGE "TB-BAR-TO-USE")
        (MAPCAN #'DELETE-PACKAGE (PACKAGE-USED-BY-LIST "TB-BAR-TO-USE"))
        (DELETE-PACKAGE "TB-BAR-TO-USE"))
      (LET ((*PACKAGE* (MAKE-PACKAGE "TB-FOO" :USE NIL)) SYMBOL)
        (AND (SETQ SYMBOL (INTERN "CAR"))
             (SHADOW "CAR")
             (MAKE-PACKAGE "TB-BAR-TO-USE" :USE NIL)
             (EXPORT (INTERN "CAR" "TB-BAR-TO-USE") "TB-BAR-TO-USE")
             (USE-PACKAGE (LIST "TB-BAR-TO-USE" "CL"))
             (EQUAL (MULTIPLE-VALUE-LIST (FIND-SYMBOL "CAR"))
                    (LIST SYMBOL :INTERNAL))
             (UNINTERN SYMBOL))))
  (PACKAGE-ERROR NIL T)
  (ERROR NIL NIL)
  (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (when (find-package "TB-BAR-TO-USE")
    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
    (delete-package "TB-BAR-TO-USE"))
  (let ((*package* (make-package "TB-FOO" :use nil))
        symbol)
    (and (setq symbol (intern "CAR"))
         (shadow "CAR")
         (make-package "TB-BAR-TO-USE" :use nil)
         (import 'cl:car "TB-BAR-TO-USE")
         (export 'cl:car "TB-BAR-TO-USE")
         (use-package (list "TB-BAR-TO-USE" "CL"))
         (equal (multiple-value-list (find-symbol "CAR"))
                (list symbol :internal))
         (unintern symbol))))



;; use-package
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (let ((*package* (make-package "TB-FOO" :use nil)))
    (and (not (find-symbol "CAR"))
         (eq (use-package 'cl) t)
         (find-symbol "CAR"))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (let ((*package* (make-package "TB-FOO" :use nil)))
    (and (not (find-symbol "CAR"))
         (eq (use-package "COMMON-LISP") t)
         (find-symbol "CAR"))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (let ((*package* (make-package "TB-FOO" :use nil)))
    (and (not (find-symbol "CAR"))
         (eq (use-package (find-package "COMMON-LISP")) t)
         (find-symbol "CAR"))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (let ((*package* (make-package "TB-FOO" :use nil)))
    (and (not (find-symbol "CAR"))
         (eq (use-package '(cl)) t)
         (find-symbol "CAR"))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (let ((*package* (make-package "TB-FOO" :use nil)))
    (and (not (find-symbol "CAR"))
         (eq (use-package '("COMMON-LISP")) t)
         (find-symbol "CAR"))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (let ((*package* (make-package "TB-FOO" :use nil)))
    (and (not (find-symbol "CAR"))
         (eq (use-package (list (find-package "COMMON-LISP"))) t)
         (find-symbol "CAR"))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (let ((package (make-package "TB-FOO" :use nil))
        (*package* (find-package 'cl-user)))
    (and (not (find-symbol "CAR" package))
         (eq (use-package (list (find-package "COMMON-LISP")) package) t)
         (find-symbol "CAR" package))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (let ((package (make-package "TB-FOO" :use nil))
        (*package* (find-package 'cl-user)))
    (and (not (find-symbol "CAR" package))
         (eq (use-package (list (find-package "COMMON-LISP")) "TB-FOO") t)
         (find-symbol "CAR" package))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (let ((package (make-package "TB-FOO" :use nil))
        (*package* (find-package 'cl-user)))
    (and (not (find-symbol "CAR" package))
         (eq (use-package (list (find-package "COMMON-LISP")) 'tb-foo) t)
         (find-symbol "CAR" package))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (let ((package (make-package "TB-FOO" :use nil))
        (*package* (find-package 'cl-user)))
    (and (not (find-symbol "CAR" package))
         (eq (use-package (list (find-package "COMMON-LISP"))
                          (find-package 'tb-foo))
             t)
         (find-symbol "CAR" package))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (let ((*package* (make-package "TB-FOO" :use nil)))
    (and (use-package 'cl)
         (member (find-package 'cl) (package-use-list *package*)))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (when (find-package "TB-BAR-TO-USE")
    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
    (delete-package "TB-BAR-TO-USE"))
  (let* ((*package* (make-package "TB-FOO" :use nil))
         boo woo buz)
    (and (make-package "TB-BAR-TO-USE" :use nil)
         (export (list (setq boo (intern "BOO" 'tb-bar-to-use))) 'tb-bar-to-use)
         (setq woo (intern "WOO"))
         (export (list (setq buz (intern "BUZ"))))
         (use-package (list 'tb-bar-to-use 'cl))
         (equal (multiple-value-list (find-symbol "BOO")) (list boo :inherited))
         (equal (multiple-value-list (find-symbol "WOO")) (list woo :internal))
         (equal (multiple-value-list (find-symbol "BUZ")) (list buz :external))
         (equal (multiple-value-list (find-symbol "CAR"))
                (list 'cl:car :inherited))
         (equal (multiple-value-list (find-symbol "LIST"))
                (list 'cl:list :inherited)))))
(HANDLER-CASE
    (PROGN
      (WHEN (FIND-PACKAGE "TB-FOO") (DELETE-PACKAGE "TB-FOO"))
      (MAKE-PACKAGE "TB-FOO" :USE NIL)
      (INTERN "CAR" 'TB-FOO)
      (USE-PACKAGE 'CL 'TB-FOO))
  (PACKAGE-ERROR NIL T)
  (ERROR NIL NIL)
  (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
(HANDLER-CASE
    (PROGN
      (WHEN (FIND-PACKAGE "TB-FOO") (DELETE-PACKAGE "TB-FOO"))
      (MAKE-PACKAGE "TB-FOO" :USE NIL)
      (EXPORT (INTERN "CAR" 'TB-FOO) 'TB-FOO)
      (USE-PACKAGE 'CL 'TB-FOO))
 (PACKAGE-ERROR NIL T)
 (ERROR NIL NIL)
 (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))
(HANDLER-CASE
    (PROGN
      (WHEN (FIND-PACKAGE "TB-FOO") (DELETE-PACKAGE "TB-FOO"))
      (WHEN (FIND-PACKAGE "TB-BAR-TO-USE")
        (MAPCAN #'DELETE-PACKAGE (PACKAGE-USED-BY-LIST "TB-BAR-TO-USE"))
        (DELETE-PACKAGE "TB-BAR-TO-USE"))
      (MAKE-PACKAGE "TB-FOO" :USE '(CL))
      (MAKE-PACKAGE "TB-BAR-TO-USE" :USE NIL)
      (EXPORT (INTERN "CAR" 'TB-BAR-TO-USE) 'TB-BAR-TO-USE)
      (USE-PACKAGE 'TB-BAR-TO-USE 'TB-FOO))
 (PACKAGE-ERROR NIL T)
 (ERROR NIL NIL)
 (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))



;; unuse-package
(progn
  (when (find-package "TB-FOO-TO-USE")
    (unuse-package (package-use-list "TB-FOO-TO-USE") "TB-FOO-TO-USE"))
  (when (find-package "TB-BAR-TO-USE")
    (unuse-package (package-use-list "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
  (when (find-package "TB-FOO-TO-USE")
    (mapcan #'delete-package (package-used-by-list "TB-FOO-TO-USE"))
    (delete-package "TB-FOO-TO-USE"))
  (when (find-package "TB-BAR-TO-USE")
    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
    (delete-package "TB-BAR-TO-USE"))
  (and (make-package "TB-FOO-TO-USE" :use nil)
       (make-package "TB-BAR-TO-USE" :use '("TB-FOO-TO-USE"))
       (use-package "TB-BAR-TO-USE" "TB-FOO-TO-USE")
       (export (intern "FOO" "TB-FOO-TO-USE") "TB-FOO-TO-USE")
       (export (intern "BAR" "TB-BAR-TO-USE") "TB-BAR-TO-USE")
       (eq (cadr (multiple-value-list (find-symbol "FOO" "TB-FOO-TO-USE")))
           :external)
       (eq (cadr (multiple-value-list (find-symbol "BAR" "TB-FOO-TO-USE")))
           :inherited)
       (eq (cadr (multiple-value-list (find-symbol "FOO" "TB-BAR-TO-USE")))
           :inherited)
       (eq (cadr (multiple-value-list (find-symbol "BAR" "TB-BAR-TO-USE")))
           :external)
       (unuse-package (package-use-list "TB-FOO-TO-USE") "TB-FOO-TO-USE")
       (unuse-package (package-use-list "TB-BAR-TO-USE") "TB-BAR-TO-USE")))
  

;; delete-package
(progn
  (when (find-package "a") (delete-package "a"))
  (and (make-package "a" :use nil)
       (delete-package "a")
       (not (find-package "a"))))
(progn
  (when (find-package "a") (delete-package "a"))
  (and (make-package "a" :use nil)
       (delete-package #\a)
       (not (find-package "a"))))
(progn
  (when (find-package "a") (delete-package "a"))
  (and (make-package "a" :use nil)
       (delete-package '|a|)
       (not (find-package "a"))))
(progn
  (when (find-package "a") (delete-package "a"))
  (and (make-package "a" :use nil)
       (delete-package (find-package '|a|))
       (not (find-package "a"))))
(progn
  (mapc #'(lambda (name) (when (find-package name) (delete-package name)))
        '("a" "b" "c" "d" "e"))
  (and (make-package "a" :nicknames '("b" "c" "d" "e") :use nil)
       (delete-package "a")
       (not (find-package "a"))
       (not (find-package "b"))
       (not (find-package "c"))
       (not (find-package "d"))
       (not (find-package "e"))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (let ((package (make-package "TB-FOO" :use nil)))
    (and (delete-package "TB-FOO")
         (not (find-package "TB-FOO"))
         (packagep package)
         (null (package-name package)))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (let ((package (make-package "TB-FOO" :use nil)))
    (and (delete-package "TB-FOO")
         (not (member package (list-all-packages))))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (let ((package (make-package "TB-FOO" :use nil)))
    (and (delete-package "TB-FOO")
         (null (delete-package package)))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (let ((car-home-package (symbol-package 'cl:car)))
    (and (make-package "TB-FOO" :use nil)
         (import 'cl:car "TB-FOO")
         (delete-package 'tb-foo)
         (eq 'cl:car (find-symbol "CAR" 'cl))
         (eq (symbol-package 'cl:car) car-home-package)
         (eq (intern "CAR" 'cl) 'cl:car))))
(HANDLER-CASE
    (PROGN
      (WHEN (FIND-PACKAGE "TB-FOO") (DELETE-PACKAGE "TB-FOO"))
      (WHEN (FIND-PACKAGE "TB-BAR-TO-USE")
        (MAPCAN #'DELETE-PACKAGE (PACKAGE-USED-BY-LIST "TB-BAR-TO-USE"))
        (DELETE-PACKAGE "TB-BAR-TO-USE"))
      (AND (MAKE-PACKAGE "TB-BAR-TO-USE" :USE NIL)
           (MAKE-PACKAGE "TB-FOO" :USE '("TB-BAR-TO-USE"))
           (DELETE-PACKAGE "TB-BAR-TO-USE")))
 (PACKAGE-ERROR NIL T)
 (ERROR NIL NIL)
 (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL))


;; in-package
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (let ((*package* (make-package "TB-FOO" :use nil)))
    (in-package cl-user)
    (eq *package* (find-package 'cl-user))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (let ((*package* (make-package "TB-FOO" :use nil)))
    (in-package "CL-USER")
    (eq *package* (find-package 'cl-user))))
(progn
  (when (find-package "A") (delete-package "A"))
  (make-package "A" :use nil)
  (let ((*package* *package*))
    (in-package "A")
    (eq *package* (find-package 'a))))
(progn
  (when (find-package "A") (delete-package "A"))
  (make-package "A" :use nil)
  (let ((*package* *package*))
    (in-package #\A)
    (eq *package* (find-package 'a))))
(progn
  (when (find-package "A") (delete-package "A"))
  (make-package "A" :use nil)
  (let ((*package* *package*))
    (in-package a)
    (eq *package* (find-package 'a))))
(progn
  #-clisp
  (progn
    (when (find-package "A") (delete-package "A"))
    (HANDLER-CASE (PROGN (IN-PACKAGE "A"))
      (PACKAGE-ERROR NIL T)
      (ERROR NIL NIL)
      (:NO-ERROR (&REST REST) (DECLARE (IGNORE REST)) NIL)))
  #+clisp 'skipped)

   
;; defpackage
(progn
  (when (find-package "A") (delete-package "A"))
  (packagep (defpackage #\A)))
(progn
  (when (find-package "A") (delete-package "A"))
  (packagep (defpackage a)))
(progn
  (when (find-package "A") (delete-package "A"))
  (packagep (defpackage "A")))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (and (packagep (defpackage "TB-FOO"))
       (null (package-nicknames 'tb-foo))
       (null (package-shadowing-symbols 'tb-foo))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (and (packagep (defpackage "TB-FOO" (:nicknames)))
       (null (package-nicknames 'tb-foo))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (and (packagep (defpackage "TB-FOO" (:nicknames) (:shadow)))
       (null (package-nicknames 'tb-foo))
       (null (package-shadowing-symbols 'tb-foo))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (and (packagep (defpackage "TB-FOO"
                   (:nicknames)
                   (:shadow)
                   (:shadowing-import-from common-lisp)))
       (null (package-nicknames 'tb-foo))
       (null (package-shadowing-symbols 'tb-foo))))
(progn
  (mapc #'(lambda (name) (when (find-package name) (delete-package name)))
        '("TB-FOO" "TB-FOO-NICKNAME-1" "TB-FOO-NICKNAME-2" "TB-FOO-NICKNAME-3"))
  (and (packagep (defpackage "TB-FOO" (:nicknames tb-foo-nickname-1)))
       (equal (package-nicknames 'tb-foo) '("TB-FOO-NICKNAME-1"))))
(progn
  (mapc #'(lambda (name) (when (find-package name) (delete-package name)))
        '("TB-FOO" "TB-FOO-NICKNAME-1" "TB-FOO-NICKNAME-2" "TB-FOO-NICKNAME-3"))
  (and (packagep (defpackage "TB-FOO"
                   (:nicknames tb-foo-nickname-1 tb-foo-nickname-2
                               tb-foo-nickname-3)))
       (equal (package-nicknames 'tb-foo)
              '("TB-FOO-NICKNAME-1" "TB-FOO-NICKNAME-2" "TB-FOO-NICKNAME-3"))))
(progn
  (mapc #'(lambda (name) (when (find-package name) (delete-package name)))
        '("A" "B" "C" "D"))
  (and (packagep (defpackage "A" (:nicknames #\B c "D")))
       (null (set-difference (package-nicknames 'a) '("B" "C" "D")
                             :test #'string=))))
(progn
  (mapc #'(lambda (name) (when (find-package name) (delete-package name)))
        '("A" "B" "C" "D"))
  (and (packagep (defpackage "A"
                   (:nicknames) (:nicknames #\B) (:nicknames c "D")))
       (null (set-difference (package-nicknames 'a) '("B" "C" "D")
                             :test #'string=))))
;(progn
;  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
;  (and (packagep (defpackage "TB-FOO"
;                   (:nicknames) (:documentation "doc for tb-foo package")))
;       (packagep (find-package 'tb-foo))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (and (packagep (defpackage "TB-FOO" (:use)))
       (null (package-use-list 'tb-foo))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (and (packagep (defpackage "TB-FOO" (:use cl)))
       (equal (package-use-list 'tb-foo) (list (find-package 'cl)))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (when (find-package "TB-BAR-TO-USE")
    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
    (delete-package "TB-BAR-TO-USE"))
  (make-package "TB-BAR-TO-USE" :use nil)
  (and (packagep (defpackage "TB-FOO" (:use cl tb-bar-to-use)))
       (null (set-difference (package-use-list 'tb-foo)
                             (mapcar #'find-package '(cl tb-bar-to-use))))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (when (find-package "TB-BAR-TO-USE")
    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
    (delete-package "TB-BAR-TO-USE"))
  (make-package "TB-BAR-TO-USE" :use nil)
  (and (packagep (defpackage "TB-FOO" (:use cl) (:use) (:use tb-bar-to-use)))
       (null (set-difference (package-use-list 'tb-foo)
                             (mapcar #'find-package '(cl tb-bar-to-use))))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (when (find-package "TB-BAR-TO-USE")
    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
    (delete-package "TB-BAR-TO-USE"))
  (make-package "TB-BAR-TO-USE" :use nil)
  (and (packagep (defpackage "TB-FOO" (:use cl) (:use) (:use "TB-BAR-TO-USE")))
       (null (set-difference (package-use-list 'tb-foo)
                             (mapcar #'find-package '(cl tb-bar-to-use))))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (when (find-package "B")
    (mapcan #'delete-package (package-used-by-list "B"))
    (delete-package "B"))
  (make-package "B" :use nil)
  (and (packagep (defpackage "TB-FOO" (:use cl) (:use) (:use "B")))
       (null (set-difference (package-use-list 'tb-foo)
                             (mapcar #'find-package '(cl b))))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (when (find-package "B")
    (mapcan #'delete-package (package-used-by-list "B"))
    (delete-package "B"))
  (make-package "B" :use nil)
  (and (packagep (defpackage "TB-FOO" (:use cl) (:use) (:use #\B)))
       (null (set-difference (package-use-list 'tb-foo)
                             (mapcar #'find-package '(cl b))))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (when (find-package "B")
    (mapcan #'delete-package (package-used-by-list "B"))
    (delete-package "B"))
  (make-package "B" :use nil)
  (and (packagep (eval `(defpackage "TB-FOO"
                         (:use cl) (:use) (:use ,(find-package #\B)))))
       (null (set-difference (package-use-list 'tb-foo)
                             (mapcar #'find-package '(cl b))))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (and (packagep (defpackage "TB-FOO" (:shadow)))
       (null (package-shadowing-symbols 'tb-foo))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (and (packagep (defpackage "TB-FOO" (:shadow "A")))
       (equal (package-shadowing-symbols 'tb-foo)
              (list (find-symbol "A" 'tb-foo)))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (and (packagep (defpackage "TB-FOO" (:shadow a #\b "c" "D")))
       (null (set-difference (package-shadowing-symbols 'tb-foo)
                             (mapcar #'(lambda (name) (find-symbol name 'tb-foo))
                                     '("A" "b" "c" "D"))))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (and (packagep (defpackage "TB-FOO" (:shadow a) (:shadow )
                             (:shadow #\b "c" "D"))))
       (null (set-difference (package-shadowing-symbols 'tb-foo)
                             (mapcar #'(lambda (name) (find-symbol name 'tb-foo))
                                     '("A" "b" "c" "D")))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (and (packagep (defpackage "TB-FOO" (:shadowing-import-from cl)))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (and (packagep (defpackage "TB-FOO" (:shadowing-import-from "COMMON-LISP")))
       (null (package-shadowing-symbols 'tb-foo))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (and (packagep (defpackage "TB-FOO"
                   (:shadowing-import-from "COMMON-LISP" car cdr list)))
       (every #'(lambda (name) (find-symbol name 'tb-foo)) '("CAR" "CDR" "LIST"))
       (null (set-difference (package-shadowing-symbols 'tb-foo)
                             '(cl:car cl:cdr cl:list)))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (and (packagep (defpackage "TB-FOO"
                   (:shadowing-import-from "COMMON-LISP" car cdr)
                   (:shadowing-import-from "COMMON-LISP")
                   (:shadowing-import-from "COMMON-LISP" list)))
       (every #'(lambda (name) (find-symbol name 'tb-foo)) '("CAR" "CDR" "LIST"))
       (null (set-difference (package-shadowing-symbols 'tb-foo)
                             '(cl:car cl:cdr cl:list)))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (when (find-package "TB-BAR-TO-USE")
    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
    (delete-package "TB-BAR-TO-USE"))
  (make-package "TB-BAR-TO-USE" :use nil)
  (let ((buz (intern "BUZ" 'tb-bar-to-use)))
    (and (packagep (defpackage "TB-FOO"
                     (:shadowing-import-from "COMMON-LISP" car cdr)
                     (:shadowing-import-from tb-bar-to-use "BUZ")))
         (every #'(lambda (name) (find-symbol name 'tb-foo)) '("CAR" "CDR"))
         (null (set-difference (package-shadowing-symbols 'tb-foo)
                               (list 'cl:car 'cl:cdr buz))))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (when (find-package "TB-BAR-TO-USE")
    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
    (delete-package "TB-BAR-TO-USE"))
  (make-package "TB-BAR-TO-USE" :use nil)
  (let ((buz (intern "BUZ" 'tb-bar-to-use))
        (baz (intern "BAZ" 'tb-bar-to-use)))
    (and (packagep (defpackage "TB-FOO"
                     (:shadowing-import-from "COMMON-LISP" car cdr)
                     (:shadowing-import-from tb-bar-to-use "BUZ" "BAZ")))
         (every #'(lambda (name) (find-symbol name 'tb-foo))
                '("CAR" "CDR" "BUZ" "BAZ"))
         (null (set-difference (package-shadowing-symbols 'tb-foo)
                               (list 'cl:car 'cl:cdr buz baz))))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (when (find-package "TB-BAR-TO-USE")
    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
    (delete-package "TB-BAR-TO-USE"))
  (make-package "TB-BAR-TO-USE" :use nil)
  (let ((buz (intern "BUZ" 'tb-bar-to-use))
        (baz (intern "BAZ" 'tb-bar-to-use)))
    (and (packagep (defpackage "TB-FOO"
                     (:shadow "BOO")
                     (:shadowing-import-from "COMMON-LISP" car cdr)
                     (:shadowing-import-from tb-bar-to-use "BUZ" "BAZ")))
         (every #'(lambda (name) (find-symbol name 'tb-foo))
                '("CAR" "CDR" "BUZ" "BAZ" "BOO"))
         (null (set-difference (package-shadowing-symbols 'tb-foo)
                               (list 'cl:car 'cl:cdr buz baz
                                     (find-symbol "BOO" 'tb-foo)))))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (and (packagep (eval `(defpackage "TB-FOO"
                         (:shadowing-import-from ,(find-package 'cl)
                          "CAR" "CDR"))))
       (every #'(lambda (name) (find-symbol name 'tb-foo)) '("CAR" "CDR"))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (and (packagep (eval `(defpackage "TB-FOO"
                         (:import-from ,(find-package 'cl)
                          "CAR" "CDR"))))
       (every #'(lambda (name) (find-symbol name 'tb-foo)) '("CAR" "CDR"))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (packagep (defpackage "TB-FOO" (:import-from cl))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (and (packagep (defpackage "TB-FOO" (:import-from cl "CAR" "CDR")))
       (every #'(lambda (name) (find-symbol name 'tb-foo)) '("CAR" "CDR"))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (and (packagep (defpackage "TB-FOO"
                   (:import-from "COMMON-LISP" car cdr list)))
       (every #'(lambda (name) (find-symbol name 'tb-foo))
              '("CAR" "CDR" "LIST"))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (and (packagep (defpackage "TB-FOO"
                   (:import-from "COMMON-LISP" car cdr)
                   (:import-from "COMMON-LISP")
                   (:import-from "COMMON-LISP" list)))
       (every #'(lambda (name) (find-symbol name 'tb-foo))
              '("CAR" "CDR" "LIST"))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (when (find-package "TB-BAR-TO-USE")
    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
    (delete-package "TB-BAR-TO-USE"))
  (make-package "TB-BAR-TO-USE" :use nil)
  (let ((buz (intern "BUZ" 'tb-bar-to-use)))
    (and (packagep (defpackage "TB-FOO"
                     (:import-from "COMMON-LISP" car cdr)
                     (:import-from tb-bar-to-use "BUZ")))
         (every #'(lambda (name) (find-symbol name 'tb-foo)) '("CAR" "CDR"))
         (eq (find-symbol "BUZ" 'tb-foo) buz))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (when (find-package "TB-BAR-TO-USE")
    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
    (delete-package "TB-BAR-TO-USE"))
  (make-package "TB-BAR-TO-USE" :use nil)
  (let ((buz (intern "BUZ" 'tb-bar-to-use))
        (baz (intern "BAZ" 'tb-bar-to-use)))
    (and (packagep (defpackage "TB-FOO"
                     (:import-from "COMMON-LISP" car cdr)
                     (:import-from tb-bar-to-use "BUZ" "BAZ")))
         (every #'(lambda (name) (find-symbol name 'tb-foo))
                '("CAR" "CDR" "BUZ" "BAZ"))
         (eq (find-symbol "BUZ" 'tb-foo) buz)
         (eq (find-symbol "BAZ" 'tb-foo) baz))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (packagep (defpackage "TB-FOO" (:export))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (packagep (defpackage "TB-FOO" (:export) (:export))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (and (packagep (defpackage "TB-FOO" (:export "A")))
       (eq (cadr (multiple-value-list (find-symbol "A" 'tb-foo))) :external)))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (and (packagep (defpackage "TB-FOO" (:export "A" "B" "C")))
       (every #'(lambda (name)
                  (eq (cadr (multiple-value-list (find-symbol name 'tb-foo)))
                      :external))
              '("A" "B" "C"))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (and (packagep (defpackage "TB-FOO" (:export "A" "B" "C")))
       (every #'(lambda (name)
                  (eq (cadr (multiple-value-list (find-symbol name 'tb-foo)))
                      :external))
              '("A" "B" "C"))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (and (packagep (defpackage "TB-FOO"
                   (:export "A") (:export "B") (:export "C")))
       (every #'(lambda (name)
                  (eq (cadr (multiple-value-list (find-symbol name 'tb-foo)))
                      :external))
              '("A" "B" "C"))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (and (packagep (defpackage "TB-FOO"
                   (:export "A" "B" "C" "CAR")
                   (:use cl)))
       (every #'(lambda (name)
                  (eq (cadr (multiple-value-list (find-symbol name 'tb-foo)))
                      :external))
              '("A" "B" "C" "CAR"))
       (eq (find-symbol "CAR" 'tb-foo) 'cl:car)))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (and (packagep (defpackage "TB-FOO"
                   (:export "A" "B" "C" "CAR")
                   (:import-from cl "CAR")))
       (every #'(lambda (name)
                  (eq (cadr (multiple-value-list (find-symbol name 'tb-foo)))
                      :external))
              '("A" "B" "C" "CAR"))
       (eq (find-symbol "CAR" 'tb-foo) 'cl:car)))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (and (packagep (defpackage "TB-FOO"
                   (:export "A" "B" "C" "CAR")
                   (:shadowing-import-from cl "CAR")))
       (every #'(lambda (name)
                  (eq (cadr (multiple-value-list (find-symbol name 'tb-foo)))
                      :external))
              '("A" "B" "C" "CAR"))
       (eq (find-symbol "CAR" 'tb-foo) 'cl:car)))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (when (find-package "TB-BAR-TO-USE")
    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
    (delete-package "TB-BAR-TO-USE"))
  (make-package "TB-BAR-TO-USE" :use nil)
  (let ((buz (intern "BUZ" 'tb-bar-to-use)))
    (and (packagep (defpackage "TB-FOO"
                     (:export "A" "B" "C" "CAR" "CDR" "BUZ")
                     (:use tb-bar-to-use)
                     (:import-from cl "CDR")
                     (:shadowing-import-from cl "CAR")))
         (every #'(lambda (name)
                    (eq (cadr (multiple-value-list (find-symbol name 'tb-foo)))
                        :external))
                '("A" "B" "C" "CAR" "CDR" "BUZ"))
         (eq (find-symbol "CAR" 'tb-foo) 'cl:car)
         (eq (find-symbol "CDR" 'tb-foo) 'cl:cdr)
         (eq (find-symbol "BUZ" 'tb-bar-to-use) buz))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (packagep (defpackage "TB-FOO" (:intern))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (packagep (defpackage "TB-FOO" (:intern) (:intern))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (and (packagep (defpackage "TB-FOO" (:intern "A")))
       (eq (cadr (multiple-value-list (find-symbol "A" 'tb-foo))) :internal)))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (and (packagep (defpackage "TB-FOO" (:intern "A" "B" "C")))
       (every #'(lambda (name)
                  (eq (cadr (multiple-value-list (find-symbol name 'tb-foo)))
                      :internal))
              '("A" "B" "C"))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (and (packagep (defpackage "TB-FOO" (:intern "A" "B" "C")))
       (every #'(lambda (name)
                  (eq (cadr (multiple-value-list (find-symbol name 'tb-foo)))
                      :internal))
              '("A" "B" "C"))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (and (packagep (defpackage "TB-FOO"
                   (:intern "A") (:intern "B") (:intern "C")))
       (every #'(lambda (name)
                  (eq (cadr (multiple-value-list (find-symbol name 'tb-foo)))
                      :internal))
              '("A" "B" "C"))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (and (packagep (defpackage "TB-FOO"
                   (:intern "A" "B" "C" "CAR")
                   (:use cl)))
       (every #'(lambda (name)
                  (eq (cadr (multiple-value-list (find-symbol name 'tb-foo)))
                      :internal))
              '("A" "B" "C"))
       (equal (multiple-value-list (find-symbol "CAR" 'tb-foo))
              '(cl:car :inherited))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (and (packagep (defpackage "TB-FOO" (:size 10)))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (and (packagep (defpackage "TB-FOO" (:size 0)))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (and (packagep (defpackage "TB-FOO" (:size 1000)))))

(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (when (find-package "TB-BAR-TO-USE")
    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
    (delete-package "TB-BAR-TO-USE"))
  (make-package "TB-BAR-TO-USE" :use nil)
  (let ((buz (intern "BUZ" 'tb-bar-to-use)))
    (export buz 'tb-bar-to-use)
    (and
     (packagep
      (defpackage "TB-FOO"
        (:size 10)
        (:shadow "SHADOW1" "SHADOW2")
        (:shadowing-import-from cl "CAR" "CDR")
        (:use tb-bar-to-use)
        (:import-from keyword "TEST")
        (:intern "S0" "S1")
        ;;(:documentation "doc")
        (:nicknames "TB-FOO-NICKNAME-0" "TB-FOO-NICKNAME-1" "TB-FOO-NICKNAME-2")
        (:export "SHADOW1" "CAR")))
     (equal (multiple-value-list (find-symbol "BUZ" 'tb-foo-nickname-0))
            (list buz :inherited))
     (eq (cadr (multiple-value-list (find-symbol "SHADOW1" 'tb-foo-nickname-2)))
         :external)
     (eq (cadr (multiple-value-list (find-symbol "SHADOW2" 'tb-foo-nickname-2)))
         :internal)
     (equal (multiple-value-list (find-symbol "CAR" 'tb-foo-nickname-2))
            (list 'cl:car :external))
     (equal (multiple-value-list (find-symbol "CDR" 'tb-foo-nickname-2))
            (list 'cl:cdr :internal))
     (equal (multiple-value-list (find-symbol "TEST" 'tb-foo-nickname-2))
            (list :test :internal))
     (eq (cadr (multiple-value-list (find-symbol "S0" 'tb-foo-nickname-2)))
         :internal)
     (eq (cadr (multiple-value-list (find-symbol "S1" 'tb-foo-nickname-2)))
         :internal)
     )))

(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (when (find-package "TB-BAR-TO-USE")
    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
    (delete-package "TB-BAR-TO-USE"))
  (make-package "TB-BAR-TO-USE" :use nil)
  (let ((buz (intern "BUZ" 'tb-bar-to-use)))
    (export buz 'tb-bar-to-use)
    (and
     (packagep
      (defpackage "TB-FOO"
        (:export "SHADOW1")
        (:size 10)
        (:nicknames "TB-FOO-NICKNAME-1" "TB-FOO-NICKNAME-2")
        (:shadow "SHADOW1")
        (:shadowing-import-from cl "CAR")
        (:intern "S1")
        (:shadowing-import-from cl)
        (:use tb-bar-to-use)
        (:nicknames "TB-FOO-NICKNAME-0")
        (:shadowing-import-from cl "CDR")
        (:shadow "SHADOW2")
        (:import-from keyword "TEST")
        (:intern "S0")
        ;;(:documentation "doc")
        (:nicknames)
        (:export "CAR")))
     (equal (multiple-value-list (find-symbol "BUZ" 'tb-foo-nickname-0))
            (list buz :inherited))
     (eq (cadr (multiple-value-list (find-symbol "SHADOW1" 'tb-foo-nickname-2)))
         :external)
     (eq (cadr (multiple-value-list (find-symbol "SHADOW2" 'tb-foo-nickname-2)))
         :internal)
     (equal (multiple-value-list (find-symbol "CAR" 'tb-foo-nickname-2))
            (list 'cl:car :external))
     (equal (multiple-value-list (find-symbol "CDR" 'tb-foo-nickname-2))
            (list 'cl:cdr :internal))
     (equal (multiple-value-list (find-symbol "TEST" 'tb-foo-nickname-2))
            (list :test :internal))
     (eq (cadr (multiple-value-list (find-symbol "S0" 'tb-foo-nickname-2)))
         :internal)
     (eq (cadr (multiple-value-list (find-symbol "S1" 'tb-foo-nickname-2)))
         :internal)
     )))





;; with-package-iterator
(with-package-iterator (get "CL" :external)
  (multiple-value-bind (more symbol status pkg) (get) (declare (ignore more))
    (and (symbolp symbol) (eq status :external) (eq pkg (find-package 'cl)))))

(with-package-iterator (get 'cl :external)
  (multiple-value-bind (more symbol status pkg) (get) (declare (ignore more))
    (and (symbolp symbol) (eq status :external) (eq pkg (find-package 'cl)))))

(with-package-iterator (get (find-package 'cl) :external)
  (multiple-value-bind (more symbol status pkg) (get) (declare (ignore more))
    (and (symbolp symbol) (eq status :external) (eq pkg (find-package 'cl)))))

(with-package-iterator (get '(cl) :external)
  (multiple-value-bind (more symbol status pkg) (get) (declare (ignore more))
    (and (symbolp symbol) (eq status :external) (eq pkg (find-package 'cl)))))

(with-package-iterator (get (list "CL") :external)
  (multiple-value-bind (more symbol status pkg) (get) (declare (ignore more))
    (and (symbolp symbol) (eq status :external) (eq pkg (find-package 'cl)))))

(with-package-iterator (get (list (find-package "COMMON-LISP")) :external)
  (multiple-value-bind (more symbol status pkg) (get) (declare (ignore more))
    (and (symbolp symbol) (eq status :external) (eq pkg (find-package 'cl)))))

(with-package-iterator (get 'cl :external :internal :inherited)
  (multiple-value-bind (more symbol status pkg) (get)
    (declare (ignore more))
    (and (symbolp symbol)
         (member status '(:external :internal :inherited))
         (eq pkg (find-package 'cl)))))

(with-package-iterator (get (list 'cl) :internal)
  (multiple-value-bind (more symbol status pkg) (get)
    (or (not more)
        (and (symbolp symbol)
             (eq status :internal)
             (eq pkg (find-package 'cl))))))

(with-package-iterator (get (list 'cl) :inherited)
  (multiple-value-bind (more symbol status pkg) (get)
    (or (not more)
        (and (symbolp symbol)
             (eq status :inherited)
             (eq pkg (find-package 'cl))))))

;;; cmucl barfs on (macrolet () (declare))
(progn
  #-cmu 
  (with-package-iterator (get "CL" :external)
    (declare (optimize (safety 3)))
    (multiple-value-bind (more symbol status pkg) (get)
      (declare (ignore more))
      (and (symbolp symbol) (eq status :external) (eq pkg (find-package 'cl)))))
  #+cmu 'skipped)
(progn
  (when (find-package "TB-FOO")
    (delete-package "TB-FOO"))
  (let ((package (make-package "TB-FOO" :use nil))
        list)
    (with-package-iterator (get package :internal)
      (and (loop
            (multiple-value-bind (more symbol status pkg) (get)
              (declare (ignore status pkg))
              (unless more (return t))
              (push symbol list)))
           (null list)))))
(progn
  (when (find-package "TB-FOO")
    (delete-package "TB-FOO"))
  (let ((package (make-package "TB-FOO" :use nil)))
    (dolist (name '(a b c d e f g "S1" "S2" "ss"))
      (intern name package))
    (with-package-iterator (get package :internal)
      (loop
       (multiple-value-bind (more symbol status pkg) (get)
         (unless more (return t))
         (unless (and (eq status :internal)
                      (eq pkg package)
                      (eq symbol (find-symbol (string symbol) pkg)))
           (return nil)))))))
(progn
  (when (find-package #\a)
    (delete-package #\a))
  (let ((package (make-package #\a :use nil)))
    (dolist (name '(a b c d e f g "S1" "S2" "ss"))
      (intern name package))
    (with-package-iterator (get #\a :internal)
      (loop
       (multiple-value-bind (more symbol status pkg) (get)
         (unless more (return t))
         (unless (and (eq status :internal)
                      (eq pkg package)
                      (eq symbol (find-symbol (string symbol) pkg)))
           (return nil)))))))
(progn
  (when (find-package #\a)
    (delete-package #\a))
  (let ((package (make-package #\a :use nil)))
    (dolist (name '(a b c d e f g "S1" "S2" "ss"))
      (intern name package))
    (with-package-iterator (get (list #\a) :internal)
      (loop
       (multiple-value-bind (more symbol status pkg) (get)
         (unless more (return t))
         (unless (and (eq status :internal)
                      (eq pkg package)
                      (eq symbol (find-symbol (string symbol) pkg)))
           (return nil)))))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (when (find-package "TB-BAR-TO-USE")
    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
    (delete-package "TB-BAR-TO-USE"))
  (let* ((package (make-package "TB-BAR-TO-USE" :use nil))
         (package-1 (make-package "TB-FOO" :use (list package)))
         (symbol-list nil))
    (export (intern "S" package) package)
    (shadow '("S") package-1)
    (with-package-iterator (get package-1 :internal :external :inherited)
      (loop
       (multiple-value-bind (more symbol status pkg) (get)
         (declare (ignore status pkg))
         (unless more (return t))
         (push symbol symbol-list))))
    (not (member (intern "S" package) symbol-list))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (let* ((package (make-package "TB-FOO" :use nil))
         (symbol-list nil))
    (with-package-iterator (get package :internal :external)
      (loop
       (multiple-value-bind (more symbol status pkg) (get)
         (declare (ignore status pkg))
         (unless more (return t))
         (push symbol symbol-list))))
    (null symbol-list)))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (let* ((package (make-package "TB-FOO" :use nil))
         (symbol-list '(a b c d car cdr i lisp))
         (list nil))
    (dolist (symbol symbol-list)
      (shadowing-import symbol package))
    (with-package-iterator (get package :internal)
      (loop
       (multiple-value-bind (more symbol status pkg) (get)
         (declare (ignore status pkg))
         (unless more (return t))
         (push symbol list))))
    (null (set-difference symbol-list list))))
(with-package-iterator (get 'cl :external)
  (loop
   (multiple-value-bind (more symbol status package) (get)
     (unless more (return t))
     (unless (and (eq status :external)
                  (eq package (find-package 'cl))
                  (eq symbol (find-symbol (symbol-name symbol) 'cl-user)))
       (return nil)))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (let* ((package (make-package "TB-FOO" :use 'cl)))
    (shadow '("CAR") package)
    (with-package-iterator (get package :external :inherited :internal)
      (loop
       (multiple-value-bind (more symbol status pkg) (get)
         (declare (ignore pkg status))
         (unless more (return t))
         (when (eq symbol 'cl:car) (return nil)))))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (let* ((*package* (make-package "TB-FOO" :use nil))
         (names '("BLACK" "RED" "WHITE" "YELLOW" "VIOLET" "BROWN" "BLUE"))
         list)
    (mapc #'intern names)
    (export (mapcar #'find-symbol
                    (mapcan #'(lambda (name)
                                (when (= (length name) 5) (list name))) names)))
    (with-package-iterator (get *package* :external :inherited :internal)
      (loop
       (multiple-value-bind (more symbol status pkg) (get)
         (declare (ignore pkg))
         (unless more (return))
         (push (symbol-name symbol) (getf list status)))))
    (and (null (set-difference (getf list :external) '("BLACK" "WHITE" "BROWN")
                               :test #'string=))
         (null (set-difference (getf list :internal)
                               '("RED" "YELLOW" "VIOLET" "BLUE")
                               :test #'string=))
         (null (getf list :inherited)))))


(flet ((test-package-iterator (package)
         (unless (packagep package)
           (setq package (find-package package)))
         (let ((all-entries '())
               (generated-entries '()))
           (do-symbols (x package) 
             (multiple-value-bind (symbol accessibility) 
                 (find-symbol (symbol-name x) package)
               (push (list symbol accessibility) all-entries)))
           (with-package-iterator (generator-fn package 
                                                :internal :external :inherited)
             (loop     
              (multiple-value-bind (more? symbol accessibility pkg)
                  (generator-fn)
                (declare (ignore pkg))
                (unless more? (return))
                (let ((l (multiple-value-list (find-symbol (symbol-name symbol) 
                                                           package))))
                  (unless (equal l (list symbol accessibility))
                    (error "Symbol ~S not found as ~S in package ~A [~S]"
                           symbol accessibility (package-name package) l))
                  (push l generated-entries)))))
           (unless (and (subsetp all-entries generated-entries :test #'equal)
                        (subsetp generated-entries all-entries :test #'equal))
             (error "Generated entries and Do-Symbols entries don't correspond"))
           t)))
  (every #'test-package-iterator '("CL" "CL-USER" "KEYWORD")))


;; do-symbols
(null (do-symbols (symbol) (declare (ignore symbol))))
(null (do-symbols (symbol *package*) (declare (ignore symbol))))
(null (do-external-symbols (symbol) (declare (ignore symbol))))
(null (do-external-symbols (symbol *package*) (declare (ignore symbol))))
(null (do-all-symbols (symbol) (declare (ignore symbol))))
(do-symbols (symbol *package* (null symbol)))
(do-external-symbols (symbol *package* (null symbol)))
(do-all-symbols (symbol (null symbol)))
(do-symbols (symbol 'CL nil) (declare (ignore symbol)) (return t))
(do-external-symbols (symbol 'CL nil) (declare (ignore symbol)) (return t))
(do-all-symbols (symbol nil) (declare (ignore symbol)) (return t))
(do-symbols (symbol 'cl nil)
  (go start)
  found
  (return t)
  start
  (when (eq symbol 'cl:car)
    (go found)))
(do-external-symbols (symbol 'cl nil)
  (go start)
  found
  (return t)
  start
  (when (eq symbol 'cl:car)
    (go found)))
(do-all-symbols (symbol nil)
  (go start)
  found
  (return t)
  start
  (when (eq symbol 'cl:car)
    (go found)))
(let ((i 0)
      (list nil)
      (*package* (find-package "COMMON-LISP-USER")))
  (do-symbols (symbol)
    (push symbol list)
    (incf i)
    (when (= i 10) (return)))
  (every #'symbolp list))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (let ((*package* (make-package "TB-FOO" :use nil))
        (name-list '("A" "B" "DOG" "CAT" "giraffe" "hippo" "wolf"))
        (list))
    (export (mapcar #'intern name-list))
    (null (set-difference (do-symbols (symbol *package* list)
                            (pushnew symbol list))
                          (mapcar #'find-symbol name-list)))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (let ((*package* (make-package "TB-FOO" :use nil))
        list)
    (do-symbols (symbol *package*) (push symbol list))
    (null list)))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (let ((*package* (make-package "TB-FOO" :use nil))
        list)
    (do-symbols (symbol) (push symbol list))
    (null list)))
(do-symbols (symbol 'cl t)
  (unless (eq symbol (find-symbol (symbol-name symbol) 'cl))
    (return nil)))
(do-symbols (symbol 'keyword t)
  (unless (equal
           (multiple-value-list (find-symbol (symbol-name symbol) 'keyword))
           (list symbol :external))
    (return nil)))


;; do-external-symbols
(let (list1 list2)
  (and (do-external-symbols (symbol 'keyword t) (push symbol list1))
       (do-symbols (symbol 'keyword t) (push symbol list2))
       (null (set-difference list1 list2))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (let ((*package* (make-package "TB-FOO" :use nil))
        list)
    (do-external-symbols (symbol *package*) (push symbol list))
    (null list)))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (let ((*package* (make-package "TB-FOO" :use nil))
        list)
    (do-external-symbols (symbol) (push symbol list))
    (null list)))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (let ((*package* (make-package "TB-FOO" :use nil))
        (name-list '("A" "B" "DOG" "CAT" "giraffe" "hippo" "wolf"))
        (list))
    (export (mapcar #'intern name-list))
    (null (set-difference (do-external-symbols (symbol *package* list)
                            (pushnew symbol list))
                          (mapcar #'find-symbol name-list)))))
(progn
  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
  (let ((*package* (make-package "TB-FOO" :use nil))
        (name-list '("A" "B" "DOG" "CAT" "giraffe" "hippo" "wolf"))
        (list))
    (mapcar #'intern name-list)
    (null (do-external-symbols (symbol *package* list)
            (pushnew symbol list)))))


;; do-all-symbols
(let ((i 0)
      (list nil))
  (do-all-symbols (symbol)
    (push symbol list)
    (incf i)
    (when (= i 10) (return)))
  (every #'symbolp list))
(let ((list nil))
  (do-all-symbols (symbol) (push symbol list))
  (with-package-iterator (get (list-all-packages) :external :internal)
    (loop
     (multiple-value-bind (more symbol status package) (get)
       (declare (ignore status package))
       (unless more (return t))
       (unless (member symbol list) (return nil))))))