Skip to content
Snippets Groups Projects
Commit 4a264a6a authored by pfdietz's avatar pfdietz
Browse files

Tests for IMPORT

parent a1f72558
No related branches found
No related tags found
No related merge requests found
......@@ -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")
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment