import.lsp 9.27 KB
Newer Older
pfdietz's avatar
pfdietz committed
1 2 3 4 5 6 7
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Thu Feb 19 07:06:48 2004
;;;; Contains: Tests of IMPORT

(in-package :cl-test)

8 9
(compile-and-load "package-aux.lsp")

pfdietz's avatar
pfdietz committed
10 11 12 13
;;; 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
sds's avatar
sds committed
14 15
        for name = (format nil "ITP-~A" i)
        unless (find-package name) return name))
pfdietz's avatar
pfdietz committed
16 17 18 19 20

(deftest import.1
  (let ((pkg-name *import-package-test-name*))
    (safely-delete-package pkg-name)
    (let ((pkg (eval `(defpackage ,pkg-name (:use))))
sds's avatar
sds committed
21
          (sym 'foo))
pfdietz's avatar
pfdietz committed
22 23 24 25 26 27 28 29 30 31 32 33
      (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))))
sds's avatar
sds committed
34
          (sym 'foo))
pfdietz's avatar
pfdietz committed
35 36 37 38 39 40 41 42 43 44 45 46
      (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))))
sds's avatar
sds committed
47
          (sym 'foo))
pfdietz's avatar
pfdietz committed
48 49 50 51 52 53 54 55 56 57 58 59
      (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))))
sds's avatar
sds committed
60
          (syms '(foo bar baz)))
pfdietz's avatar
pfdietz committed
61 62 63
      (values
       (multiple-value-list (import syms pkg))
       (loop for sym in syms always
sds's avatar
sds committed
64
             (eqlt (find-symbol (symbol-name sym) pkg) sym))
pfdietz's avatar
pfdietz committed
65
       (loop for sym in syms always
sds's avatar
sds committed
66
             (eqlt (symbol-package sym) (find-package :cl-test)))
pfdietz's avatar
pfdietz committed
67 68 69 70 71 72 73 74
       (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))))
sds's avatar
sds committed
75
          (sym (make-symbol (symbol-name :foo))))
pfdietz's avatar
pfdietz committed
76 77 78 79 80 81 82 83 84 85 86 87
      (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))))
sds's avatar
sds committed
88
           (sym (intern (symbol-name :foo) pkg)))
pfdietz's avatar
pfdietz committed
89 90 91 92 93 94 95 96 97 98 99 100
      (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))))
sds's avatar
sds committed
101
           (sym (intern (symbol-name :foo) pkg)))
pfdietz's avatar
pfdietz committed
102 103 104 105 106 107 108 109 110 111 112 113 114
      (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))))
sds's avatar
sds committed
115
          (sym 'foo))
pfdietz's avatar
pfdietz committed
116 117 118 119 120 121 122 123 124 125 126 127
      (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))))
sds's avatar
sds committed
128
          (sym 'foo))
pfdietz's avatar
pfdietz committed
129 130 131 132 133 134 135 136
      (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)

137 138 139 140
(deftest import.10
  (let ((pkg-name *import-package-test-name*))
    (safely-delete-package pkg-name)
    (let ((pkg (eval `(defpackage ,pkg-name (:use))))
sds's avatar
sds committed
141
          (sym 'foo))
142 143
      (values
       (let ((pname (make-array (length pkg-name) :element-type 'base-char
sds's avatar
sds committed
144 145
                                :initial-contents pkg-name)))
         (multiple-value-list (import sym pname)))
146 147 148 149 150 151 152 153 154 155
       (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))))
sds's avatar
sds committed
156
          (sym 'foo))
157 158
      (values
       (let ((pname (make-array (+ 3 (length pkg-name))
sds's avatar
sds committed
159 160 161 162
                                :element-type 'base-char
                                :fill-pointer (length pkg-name)
                                :initial-contents (concatenate 'string pkg-name "XYZ"))))
         (multiple-value-list (import sym pname)))
163 164 165 166 167 168 169 170 171 172
       (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))))
sds's avatar
sds committed
173
          (sym 'foo))
174 175
      (values
       (let* ((pname0 (make-array (+ 4 (length pkg-name))
sds's avatar
sds committed
176 177 178 179 180 181 182
                                :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)))
183 184 185 186 187 188 189
       (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)


pfdietz's avatar
pfdietz committed
190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205

;;; 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))))
sds's avatar
sds committed
206 207
            (sym 'foo)
            (name (symbol-name sym)))
pfdietz's avatar
pfdietz committed
208 209 210 211 212 213 214 215 216
       (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))))
sds's avatar
sds committed
217 218 219 220
           (sym 'foo)
           (name (symbol-name sym))
           (isym (intern name pkg))
           (outer-restarts (compute-restarts)))
221
      (block done
sds's avatar
sds committed
222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241
        (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))))
242 243
  :good)

pfdietz's avatar
pfdietz committed
244 245 246 247 248

(deftest import.error.5
  (let ((pkg-name *import-package-test-name*))
    (safely-delete-package pkg-name)
    (let* ((pkg (eval `(defpackage ,pkg-name (:use))))
sds's avatar
sds committed
249 250 251 252
           (sym 'foo)
           (name (symbol-name sym))
           (isym (shadow name pkg))  ;; shadow instead of intern
           (outer-restarts (compute-restarts)))
253
      (block done
sds's avatar
sds committed
254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273
        (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))))
274
  :good)