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)
12. Make sure all string operators work on displaced character vectors.
13. Add tests for IMPORT.
14. Finish testing DEFSETF
......@@ -1358,6 +1358,13 @@ the condition to go uncaught if it cannot be classified."
(declare (ignorable s))
(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)
(let ((package (find-package package-designator)))
(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 @@
(load "packages-17.lsp")
(load "packages-18.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