source: trunk/source/tests/ansi-tests/import.lsp @ 8991

Last change on this file since 8991 was 8991, checked in by gz, 11 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

File size: 8.3 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Thu Feb 19 07:06:48 2004
4;;;; Contains: Tests of IMPORT
5
6(in-package :cl-test)
7
8(compile-and-load "package-aux.lsp")
9
10;;; Create a package name that does not collide with an existing package
11;;; name or nickname
12(defvar *import-package-test-name*
13  (loop for i from 1
14        for name = (format nil "ITP-~A" i)
15        unless (find-package name) return name))
16
17(deftest import.1
18  (let ((pkg-name *import-package-test-name*))
19    (safely-delete-package pkg-name)
20    (let ((pkg (eval `(defpackage ,pkg-name (:use))))
21          (sym 'foo))
22      (values
23       (multiple-value-list (import sym pkg))
24       (eqlt (find-symbol (symbol-name sym) pkg) sym)
25       (eqlt (symbol-package sym) (find-package :cl-test))
26       (external-symbols-in-package pkg)
27       )))
28  (t) t t nil)
29
30(deftest import.2
31  (let ((pkg-name *import-package-test-name*))
32    (safely-delete-package pkg-name)
33    (let ((pkg (eval `(defpackage ,pkg-name (:use))))
34          (sym 'foo))
35      (values
36       (multiple-value-list (import (list sym) pkg))
37       (eqlt (find-symbol (symbol-name sym) pkg) sym)
38       (eqlt (symbol-package sym) (find-package :cl-test))
39       (external-symbols-in-package pkg)
40       )))
41  (t) t t nil)
42
43(deftest import.3
44  (let ((pkg-name *import-package-test-name*))
45    (safely-delete-package pkg-name)
46    (let ((*package* (eval `(defpackage ,pkg-name (:use))))
47          (sym 'foo))
48      (values
49       (multiple-value-list (import sym))
50       (eqlt (find-symbol (symbol-name sym)) sym)
51       (eqlt (symbol-package sym) (find-package :cl-test))
52       (external-symbols-in-package *package*)
53       )))
54  (t) t t nil)
55
56(deftest import.4
57  (let ((pkg-name *import-package-test-name*))
58    (safely-delete-package pkg-name)
59    (let ((pkg (eval `(defpackage ,pkg-name (:use))))
60          (syms '(foo bar baz)))
61      (values
62       (multiple-value-list (import syms pkg))
63       (loop for sym in syms always
64             (eqlt (find-symbol (symbol-name sym) pkg) sym))
65       (loop for sym in syms always
66             (eqlt (symbol-package sym) (find-package :cl-test)))
67       (external-symbols-in-package pkg)
68       )))
69  (t) t t nil)
70
71(deftest import.5
72  (let ((pkg-name *import-package-test-name*))
73    (safely-delete-package pkg-name)
74    (let ((pkg (eval `(defpackage ,pkg-name (:use))))
75          (sym (make-symbol (symbol-name :foo))))
76      (values
77       (multiple-value-list (import sym pkg))
78       (eqlt (symbol-package sym) pkg)
79       (eqlt (find-symbol (symbol-name sym) pkg) sym)
80       (external-symbols-in-package pkg)
81       )))
82  (t) t t nil)
83
84(deftest import.6
85  (let ((pkg-name *import-package-test-name*))
86    (safely-delete-package pkg-name)
87    (let* ((pkg (eval `(defpackage ,pkg-name (:use))))
88           (sym (intern (symbol-name :foo) pkg)))
89      (values
90       (multiple-value-list (import sym pkg))
91       (eqlt (symbol-package sym) pkg)
92       (eqlt (find-symbol (symbol-name sym) pkg) sym)
93       (external-symbols-in-package pkg)
94       )))
95  (t) t t nil)
96
97(deftest import.7
98  (let ((pkg-name *import-package-test-name*))
99    (safely-delete-package pkg-name)
100    (let* ((pkg (eval `(defpackage ,pkg-name (:use) (:export #:foo))))
101           (sym (intern (symbol-name :foo) pkg)))
102      (values
103       (multiple-value-list (import sym pkg))
104       (eqlt (symbol-package sym) pkg)
105       (eqlt (find-symbol (symbol-name sym) pkg) sym)
106       (length (external-symbols-in-package pkg))
107       (eqlt (car (external-symbols-in-package pkg)) sym)
108       )))
109  (t) t t 1 t)
110
111(deftest import.8
112  (let ((pkg-name *import-package-test-name*))
113    (safely-delete-package pkg-name)
114    (let ((pkg (eval `(defpackage ,pkg-name (:use))))
115          (sym 'foo))
116      (values
117       (multiple-value-list (import sym pkg-name))
118       (eqlt (find-symbol (symbol-name sym) pkg) sym)
119       (eqlt (symbol-package sym) (find-package :cl-test))
120       (external-symbols-in-package pkg)
121       )))
122  (t) t t nil)
123
124(deftest import.9
125  (let ((pkg-name "Z"))
126    (safely-delete-package pkg-name)
127    (let ((pkg (eval `(defpackage ,pkg-name (:use))))
128          (sym 'foo))
129      (values
130       (multiple-value-list (import sym #\Z))
131       (eqlt (find-symbol (symbol-name sym) pkg) sym)
132       (eqlt (symbol-package sym) (find-package :cl-test))
133       (external-symbols-in-package pkg)
134       )))
135  (t) t t nil)
136
137(deftest import.10
138  (let ((pkg-name *import-package-test-name*))
139    (safely-delete-package pkg-name)
140    (let ((pkg (eval `(defpackage ,pkg-name (:use))))
141          (sym 'foo))
142      (values
143       (let ((pname (make-array (length pkg-name) :element-type 'base-char
144                                :initial-contents pkg-name)))
145         (multiple-value-list (import sym pname)))
146       (eqlt (find-symbol (symbol-name sym) pkg) sym)
147       (eqlt (symbol-package sym) (find-package :cl-test))
148       (external-symbols-in-package pkg)
149       )))
150  (t) t t nil)
151
152(deftest import.11
153  (let ((pkg-name *import-package-test-name*))
154    (safely-delete-package pkg-name)
155    (let ((pkg (eval `(defpackage ,pkg-name (:use))))
156          (sym 'foo))
157      (values
158       (let ((pname (make-array (+ 3 (length pkg-name))
159                                :element-type 'base-char
160                                :fill-pointer (length pkg-name)
161                                :initial-contents (concatenate 'string pkg-name "XYZ"))))
162         (multiple-value-list (import sym pname)))
163       (eqlt (find-symbol (symbol-name sym) pkg) sym)
164       (eqlt (symbol-package sym) (find-package :cl-test))
165       (external-symbols-in-package pkg)
166       )))
167  (t) t t nil)
168
169(deftest import.12
170  (let ((pkg-name *import-package-test-name*))
171    (safely-delete-package pkg-name)
172    (let ((pkg (eval `(defpackage ,pkg-name (:use))))
173          (sym 'foo))
174      (values
175       (let* ((pname0 (make-array (+ 4 (length pkg-name))
176                                :element-type 'base-char
177                                :fill-pointer (length pkg-name)
178                                :initial-contents (concatenate 'string "  " pkg-name "XY")))
179              (pname (make-array (length pkg-name) :element-type 'base-char
180                                 :displaced-to pname0
181                                 :displaced-index-offset 2)))
182         (multiple-value-list (import sym pname)))
183       (eqlt (find-symbol (symbol-name sym) pkg) sym)
184       (eqlt (symbol-package sym) (find-package :cl-test))
185       (external-symbols-in-package pkg)
186       )))
187  (t) t t nil)
188
189
190
191;;; Error tests
192
193(deftest import.error.1
194  (signals-error (import) program-error)
195  t)
196
197(deftest import.error.2
198  (signals-error (import 'nil (find-package :cl-test) nil) program-error)
199  t)
200
201(deftest import.error.3
202  (signals-error
203   (let ((pkg-name *import-package-test-name*))
204     (safely-delete-package pkg-name)
205     (let* ((pkg (eval `(defpackage ,pkg-name (:use))))
206            (sym 'foo)
207            (name (symbol-name sym)))
208       (intern name pkg)
209       (import sym pkg)))
210   package-error)
211  t)
212
213(deftest import.error.4
214  (let ((pkg-name *import-package-test-name*))
215    (safely-delete-package pkg-name)
216    (let* ((pkg (eval `(defpackage ,pkg-name (:use))))
217           (sym 'foo)
218           (name (symbol-name sym))
219           (isym (intern name pkg))
220           (outer-restarts (compute-restarts)))
221      (block done
222        (and
223         (handler-bind
224          ((package-error
225            #'(lambda (c)
226                ;; There should be at least one restart
227                ;; associated with this condition that was
228                ;; not a preexisting restart
229                (let ((my-restarts
230                       (remove 'abort
231                               (set-difference (compute-restarts c)
232                                               outer-restarts)
233                               :key #'restart-name)))
234                  (assert my-restarts)
235                ; (unintern isym pkg)
236                ; (when (find 'continue my-restarts :key #'restart-name) (continue c))
237                (return-from done :good)))))
238          (import sym pkg))
239         (eqlt (find-symbol name pkg) sym)
240         (eqlt (symbol-package sym) (find-package "CL-TEST"))
241         :good))))
242  :good)
243
244
245(deftest import.error.5
246  (let ((pkg-name *import-package-test-name*))
247    (safely-delete-package pkg-name)
248    (let* ((pkg (eval `(defpackage ,pkg-name (:use))))
249           (sym 'foo)
250           (name (symbol-name sym))
251           (isym (shadow name pkg))  ;; shadow instead of intern
252           (outer-restarts (compute-restarts)))
253      (block done
254        (and
255         (handler-bind
256          ((package-error
257            #'(lambda (c)
258                ;; There should be at least one restart
259                ;; associated with this condition that was
260                ;; not a preexisting restart
261                (let ((my-restarts
262                       (remove 'abort
263                               (set-difference (compute-restarts c)
264                                               outer-restarts)
265                               :key #'restart-name)))
266                  (assert my-restarts)
267                  ; (unintern isym pkg)
268                  ; (when (find 'continue my-restarts :key #'restart-name) (continue c))
269                  (return-from done :good)))))
270          (import sym pkg))
271         (eqlt (find-symbol name pkg) sym)
272         (eqlt (symbol-package sym) (find-package "CL-TEST"))
273         :good))))
274  :good)
Note: See TracBrowser for help on using the repository browser.