Commit 4a264a6a authored by pfdietz's avatar pfdietz

Tests for IMPORT

parent a1f72558
...@@ -27,6 +27,4 @@ Things to do to the test suite (not a complete list) ...@@ -27,6 +27,4 @@ Things to do to the test suite (not a complete list)
12. Make sure all string operators work on displaced character vectors. 12. Make sure all string operators work on displaced character vectors.
13. Add tests for IMPORT.
14. Finish testing DEFSETF 14. Finish testing DEFSETF
...@@ -1358,6 +1358,13 @@ the condition to go uncaught if it cannot be classified." ...@@ -1358,6 +1358,13 @@ the condition to go uncaught if it cannot be classified."
(declare (ignorable s)) (declare (ignorable s))
(incf num)))) (incf num))))
(defun external-symbols-in-package (p)
(let ((symbols nil))
(do-external-symbols (s p)
(push s symbols))
(sort symbols #'(lambda (s1 s2) (string< (symbol-name s1)
(symbol-name s2))))))
(defun safely-delete-package (package-designator) (defun safely-delete-package (package-designator)
(let ((package (find-package package-designator))) (let ((package (find-package package-designator)))
(when package (when package
......
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Thu Feb 19 07:06:48 2004
;;;; Contains: Tests of IMPORT
(in-package :cl-test)
;;; 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)
;;; 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)))
(values
(handler-bind
((package-error
#'(lambda (c)
(let ((r (find-restart 'continue c)))
;; Get rid of the conflicting symbol
(unintern isym)
(and r (invoke-restart r))))))
(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.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)))
(values
(handler-bind
((package-error
#'(lambda (c)
(let ((r (find-restart 'continue c)))
;; Get rid of the conflicting symbol
(unintern isym)
(and r (invoke-restart r))))))
(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)
...@@ -24,3 +24,5 @@ ...@@ -24,3 +24,5 @@
(load "packages-17.lsp") (load "packages-17.lsp")
(load "packages-18.lsp") (load "packages-18.lsp")
(load "packages-19.lsp") (load "packages-19.lsp")
(load "import.lsp")
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment