;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sun Aug 29 07:42:18 2004
;;;; Contains: Tests for SHADOWING-IMPORT



(deftest shadowing-import.1
  (let ((name1 "TEST1")
        (name2 "TEST2"))
    (safely-delete-package name1)
    (safely-delete-package name2)
    (prog1
        (let* ((p1 (make-package name1 :use nil))
               (p2 (make-package name2))
               (s1 (intern "X" p1))
               (s2 (intern "X" p2)))
          (list
           (eqt s1 s2)
           (eqt (find-symbol "X" p2) s2)
           (shadowing-import s1 p2)
           (equalt (package-shadowing-symbols p2) (list s1))
           (eqt (find-symbol "X" p2) s1)))
      (safely-delete-package name1)
      (safely-delete-package name2)))
  (nil t t t t))

(deftest shadowing-import.2
  (let ((name1 "TEST1")
        (name2 "TEST2"))
    (safely-delete-package name1)
    (safely-delete-package name2)
    (prog1
        (let* ((p1 (make-package name1 :use nil))
               (p2 (make-package name2))
               (s1 (intern "X" p1)))
          (list
           (find-symbol "X" p2)
           (shadowing-import s1 p2)
           (equalt (package-shadowing-symbols p2) (list s1))
           (eqt (find-symbol "X" p2) s1)))
      (safely-delete-package name1)
      (safely-delete-package name2)))
  (nil t t t))

(deftest shadowing-import.3
  (let ((name1 "TEST1")
        (name2 "TEST2"))
    (safely-delete-package name1)
    (safely-delete-package name2)
    (prog1
        (let* ((p1 (make-package name1 :use nil))
               (p2 (make-package name2 :use nil))
               (s1 (intern "X" p1))
               (s2 (intern "X" p2)))
          (list
           (eqt s1 s2)
           (eqt (find-symbol "X" p2) s2)
           (let ((*package* p2))
             (shadowing-import s1))
           (equalt (package-shadowing-symbols p2) (list s1))
           (eqt (find-symbol "X" p2) s1)))
      (safely-delete-package name1)
      (safely-delete-package name2)))
  (nil t t t t))

(deftest shadowing-import.4
  (let ((name1 "TEST1")
        (name2 "TEST2")
        (name3 "TEST3"))
    (safely-delete-package name1)
    (safely-delete-package name2)
    (safely-delete-package name3)
    (prog1
        (let* ((p1 (make-package name1 :use nil))
               (p3 (make-package name2 :use nil))
               (p2 (make-package name3 :use (list p3)))
               (s1 (intern "X" p1))
               (s2 (intern "X" p3)))
          (export s2 p3)
          (list
           (eqt s1 s2)
           (eqt (find-symbol "X" p2) s2)
           (shadowing-import s1 p2)
           (equalt (package-shadowing-symbols p2) (list s1))
           (eqt (find-symbol "X" p2) s1)))
      (safely-delete-package name1)
      (safely-delete-package name3)
      (safely-delete-package name2)))
  (nil t t t t))

;;; Specialized sequence tests

(defmacro def-shadowing-import-test (test-name name-form)
  `(deftest ,test-name
     (let ((name1 ,name-form))
       (safely-delete-package name1)
       (prog1
           (let* ((p1 (make-package name1 :use nil)))
             (list
              (find-symbol "T" p1)
              (shadowing-import t name1)
              (package-shadowing-symbols p1)
              (find-symbol "T" p1)))
         (safely-delete-package name1)))
     (nil t (t) t)))

(def-shadowing-import-test shadowing-import.5
  (make-array '(5) :initial-contents "TEST1"
              :element-type 'base-char))

(def-shadowing-import-test shadowing-import.6
  (make-array '(7) :initial-contents "TEST1XX"
              :fill-pointer 7
              :element-type 'character))

(def-shadowing-import-test shadowing-import.7
  (make-array '(7) :initial-contents "TEST1XX"
              :fill-pointer 7
              :element-type 'base-char))

(def-shadowing-import-test shadowing-import.8
  (make-array '(5) :initial-contents "TEST1"
              :adjustable t
              :element-type 'base-char))

(def-shadowing-import-test shadowing-import.9
  (make-array '(5) :initial-contents "TEST1"
              :adjustable t
              :element-type 'character))

(def-shadowing-import-test shadowing-import.10
  (let* ((etype 'character)
         (name2 (make-array '(10) :initial-contents "ABTEST1CDE"
                            :element-type etype)))
    (make-array '(5) :element-type etype
                :displaced-to name2
                :displaced-index-offset 2)))

(def-shadowing-import-test shadowing-import.11
  (let* ((etype 'base-char)
         (name2 (make-array '(10) :initial-contents "ABTEST1CDE"
                            :element-type etype)))
    (make-array '(5) :element-type etype
                :displaced-to name2
                :displaced-index-offset 2)))

;;; Error tests

(deftest shadowing-import.error.1
  (signals-error (shadowing-import) program-error)
  t)

(deftest shadowing-import.error.2
  (signals-error (shadowing-import nil *package* nil)
                 program-error)
  t)