From 4a264a6ae0ad1fc0cb83329a9b0d4b5e8ba70d6e Mon Sep 17 00:00:00 2001 From: pfdietz Date: Thu, 19 Feb 2004 14:04:46 +0000 Subject: [PATCH] Tests for IMPORT --- ansi-tests/TODO | 2 - ansi-tests/ansi-aux.lsp | 7 ++ ansi-tests/import.lsp | 198 ++++++++++++++++++++++++++++++++++++++++ ansi-tests/packages.lsp | 2 + 4 files changed, 207 insertions(+), 2 deletions(-) create mode 100644 ansi-tests/import.lsp diff --git a/ansi-tests/TODO b/ansi-tests/TODO index d50223f..b182289 100644 --- a/ansi-tests/TODO +++ b/ansi-tests/TODO @@ -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 diff --git a/ansi-tests/ansi-aux.lsp b/ansi-tests/ansi-aux.lsp index 44440ce..77627e8 100644 --- a/ansi-tests/ansi-aux.lsp +++ b/ansi-tests/ansi-aux.lsp @@ -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 diff --git a/ansi-tests/import.lsp b/ansi-tests/import.lsp new file mode 100644 index 0000000..af37b3c --- /dev/null +++ b/ansi-tests/import.lsp @@ -0,0 +1,198 @@ +;-*- 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) diff --git a/ansi-tests/packages.lsp b/ansi-tests/packages.lsp index dc6b38e..113ea83 100644 --- a/ansi-tests/packages.lsp +++ b/ansi-tests/packages.lsp @@ -24,3 +24,5 @@ (load "packages-17.lsp") (load "packages-18.lsp") (load "packages-19.lsp") + +(load "import.lsp") -- GitLab