;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Thu Feb 19 07:06:48 2004
;;;; Contains: Tests of IMPORT





;;; Create a package name that does not collide with an existing package
;;; name or nickname
(defvar *import-package-test-name*
  (loop for i from 1
        for name = (format nil "ITP-~A" i)
        unless (find-package name) return name))

(deftest import.1
  (let ((pkg-name *import-package-test-name*))
    (safely-delete-package pkg-name)
    (let ((pkg (eval `(defpackage ,pkg-name (:use))))
          (sym 'foo))
      (values
       (multiple-value-list (import sym pkg))
       (eqlt (find-symbol (symbol-name sym) pkg) sym)
       (eqlt (symbol-package sym) (find-package :cl-test))
       (external-symbols-in-package pkg)
       )))
  (t) t t nil)

(deftest import.2
  (let ((pkg-name *import-package-test-name*))
    (safely-delete-package pkg-name)
    (let ((pkg (eval `(defpackage ,pkg-name (:use))))
          (sym 'foo))
      (values
       (multiple-value-list (import (list sym) pkg))
       (eqlt (find-symbol (symbol-name sym) pkg) sym)
       (eqlt (symbol-package sym) (find-package :cl-test))
       (external-symbols-in-package pkg)
       )))
  (t) t t nil)

(deftest import.3
  (let ((pkg-name *import-package-test-name*))
    (safely-delete-package pkg-name)
    (let ((*package* (eval `(defpackage ,pkg-name (:use))))
          (sym 'foo))
      (values
       (multiple-value-list (import sym))
       (eqlt (find-symbol (symbol-name sym)) sym)
       (eqlt (symbol-package sym) (find-package :cl-test))
       (external-symbols-in-package *package*)
       )))
  (t) t t nil)

(deftest import.4
  (let ((pkg-name *import-package-test-name*))
    (safely-delete-package pkg-name)
    (let ((pkg (eval `(defpackage ,pkg-name (:use))))
          (syms '(foo bar baz)))
      (values
       (multiple-value-list (import syms pkg))
       (loop for sym in syms always
             (eqlt (find-symbol (symbol-name sym) pkg) sym))
       (loop for sym in syms always
             (eqlt (symbol-package sym) (find-package :cl-test)))
       (external-symbols-in-package pkg)
       )))
  (t) t t nil)

(deftest import.5
  (let ((pkg-name *import-package-test-name*))
    (safely-delete-package pkg-name)
    (let ((pkg (eval `(defpackage ,pkg-name (:use))))
          (sym (make-symbol (symbol-name :foo))))
      (values
       (multiple-value-list (import sym pkg))
       (eqlt (symbol-package sym) pkg)
       (eqlt (find-symbol (symbol-name sym) pkg) sym)
       (external-symbols-in-package pkg)
       )))
  (t) t t nil)

(deftest import.6
  (let ((pkg-name *import-package-test-name*))
    (safely-delete-package pkg-name)
    (let* ((pkg (eval `(defpackage ,pkg-name (:use))))
           (sym (intern (symbol-name :foo) pkg)))
      (values
       (multiple-value-list (import sym pkg))
       (eqlt (symbol-package sym) pkg)
       (eqlt (find-symbol (symbol-name sym) pkg) sym)
       (external-symbols-in-package pkg)
       )))
  (t) t t nil)

(deftest import.7
  (let ((pkg-name *import-package-test-name*))
    (safely-delete-package pkg-name)
    (let* ((pkg (eval `(defpackage ,pkg-name (:use) (:export #:foo))))
           (sym (intern (symbol-name :foo) pkg)))
      (values
       (multiple-value-list (import sym pkg))
       (eqlt (symbol-package sym) pkg)
       (eqlt (find-symbol (symbol-name sym) pkg) sym)
       (length (external-symbols-in-package pkg))
       (eqlt (car (external-symbols-in-package pkg)) sym)
       )))
  (t) t t 1 t)

(deftest import.8
  (let ((pkg-name *import-package-test-name*))
    (safely-delete-package pkg-name)
    (let ((pkg (eval `(defpackage ,pkg-name (:use))))
          (sym 'foo))
      (values
       (multiple-value-list (import sym pkg-name))
       (eqlt (find-symbol (symbol-name sym) pkg) sym)
       (eqlt (symbol-package sym) (find-package :cl-test))
       (external-symbols-in-package pkg)
       )))
  (t) t t nil)

(deftest import.9
  (let ((pkg-name "Z"))
    (safely-delete-package pkg-name)
    (let ((pkg (eval `(defpackage ,pkg-name (:use))))
          (sym 'foo))
      (values
       (multiple-value-list (import sym #\Z))
       (eqlt (find-symbol (symbol-name sym) pkg) sym)
       (eqlt (symbol-package sym) (find-package :cl-test))
       (external-symbols-in-package pkg)
       )))
  (t) t t nil)

(deftest import.10
  (let ((pkg-name *import-package-test-name*))
    (safely-delete-package pkg-name)
    (let ((pkg (eval `(defpackage ,pkg-name (:use))))
          (sym 'foo))
      (values
       (let ((pname (make-array (length pkg-name) :element-type 'base-char
                                :initial-contents pkg-name)))
         (multiple-value-list (import sym pname)))
       (eqlt (find-symbol (symbol-name sym) pkg) sym)
       (eqlt (symbol-package sym) (find-package :cl-test))
       (external-symbols-in-package pkg)
       )))
  (t) t t nil)

(deftest import.11
  (let ((pkg-name *import-package-test-name*))
    (safely-delete-package pkg-name)
    (let ((pkg (eval `(defpackage ,pkg-name (:use))))
          (sym 'foo))
      (values
       (let ((pname (make-array (+ 3 (length pkg-name))
                                :element-type 'base-char
                                :fill-pointer (length pkg-name)
                                :initial-contents (concatenate 'string pkg-name "XYZ"))))
         (multiple-value-list (import sym pname)))
       (eqlt (find-symbol (symbol-name sym) pkg) sym)
       (eqlt (symbol-package sym) (find-package :cl-test))
       (external-symbols-in-package pkg)
       )))
  (t) t t nil)

(deftest import.12
  (let ((pkg-name *import-package-test-name*))
    (safely-delete-package pkg-name)
    (let ((pkg (eval `(defpackage ,pkg-name (:use))))
          (sym 'foo))
      (values
       (let* ((pname0 (make-array (+ 4 (length pkg-name))
                                :element-type 'base-char
                                :fill-pointer (length pkg-name)
                                :initial-contents (concatenate 'string "  " pkg-name "XY")))
              (pname (make-array (length pkg-name) :element-type 'base-char
                                 :displaced-to pname0
                                 :displaced-index-offset 2)))
         (multiple-value-list (import sym pname)))
       (eqlt (find-symbol (symbol-name sym) pkg) sym)
       (eqlt (symbol-package sym) (find-package :cl-test))
       (external-symbols-in-package pkg)
       )))
  (t) t t nil)



;;; Error tests

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

(deftest import.error.2
  (signals-error (import 'nil (find-package :cl-test) nil) program-error)
  t)

(deftest import.error.3
  (signals-error
   (let ((pkg-name *import-package-test-name*))
     (safely-delete-package pkg-name)
     (let* ((pkg (eval `(defpackage ,pkg-name (:use))))
            (sym 'foo)
            (name (symbol-name sym)))
       (intern name pkg)
       (import sym pkg)))
   package-error)
  t)

(deftest import.error.4
  (let ((pkg-name *import-package-test-name*))
    (safely-delete-package pkg-name)
    (let* ((pkg (eval `(defpackage ,pkg-name (:use))))
           (sym 'foo)
           (name (symbol-name sym))
           (isym (intern name pkg))
           (outer-restarts (compute-restarts)))
      (block done
        (and
         (handler-bind
          ((package-error
            #'(lambda (c)
                ;; There should be at least one restart
                ;; associated with this condition that was
                ;; not a preexisting restart
                (let ((my-restarts
                       (remove 'abort
                               (set-difference (compute-restarts c)
                                               outer-restarts)
                               :key #'restart-name)))
                  (assert my-restarts)
                ; (unintern isym pkg)
                ; (when (find 'continue my-restarts :key #'restart-name) (continue c))
                (return-from done :good)))))
          (import sym pkg))
         (eqlt (find-symbol name pkg) sym)
         (eqlt (symbol-package sym) (find-package "CL-TEST"))
         :good))))
  :good)


(deftest import.error.5
  (let ((pkg-name *import-package-test-name*))
    (safely-delete-package pkg-name)
    (let* ((pkg (eval `(defpackage ,pkg-name (:use))))
           (sym 'foo)
           (name (symbol-name sym))
           (isym (shadow name pkg))  ;; shadow instead of intern
           (outer-restarts (compute-restarts)))
      (block done
        (and
         (handler-bind
          ((package-error
            #'(lambda (c)
                ;; There should be at least one restart
                ;; associated with this condition that was
                ;; not a preexisting restart
                (let ((my-restarts
                       (remove 'abort
                               (set-difference (compute-restarts c)
                                               outer-restarts)
                               :key #'restart-name)))
                  (assert my-restarts)
                  ; (unintern isym pkg)
                  ; (when (find 'continue my-restarts :key #'restart-name) (continue c))
                  (return-from done :good)))))
          (import sym pkg))
         (eqlt (find-symbol name pkg) sym)
         (eqlt (symbol-package sym) (find-package "CL-TEST"))
         :good))))
  :good)