10 |
;;; export |
;;; export |
11 |
|
|
12 |
(deftest export-1 |
(deftest export-1 |
13 |
(let ((return-value nil)) |
(let ((return-value nil)) |
14 |
(ignore-errors (delete-package "TEST1")) |
(ignore-errors (delete-package "TEST1")) |
15 |
(let ((p (make-package "TEST1"))) |
(let ((p (make-package "TEST1"))) |
16 |
(let ((sym (intern "FOO" p))) |
(let ((sym (intern "FOO" p))) |
17 |
(setf return-value (export sym p)) |
(setf return-value (export sym p)) |
18 |
(multiple-value-bind (sym2 status) |
(multiple-value-bind (sym2 status) |
19 |
(find-symbol "FOO" p) |
(find-symbol "FOO" p) |
20 |
(prog1 |
(prog1 |
21 |
(and sym2 |
(and sym2 |
22 |
(eqt (symbol-package sym2) p) |
(eqt (symbol-package sym2) p) |
23 |
(string= (symbol-name sym2) "FOO") |
(string= (symbol-name sym2) "FOO") |
24 |
(eqt sym sym2) |
(eqt sym sym2) |
25 |
(eqt status :external)) |
(eqt status :external)) |
26 |
(delete-package p))))) |
(delete-package p))))) |
27 |
return-value) |
return-value) |
28 |
t) |
t) |
29 |
|
|
30 |
(deftest export-2 |
(deftest export-2 |
31 |
(progn (ignore-errors (delete-package "TEST1")) |
(progn (ignore-errors (delete-package "TEST1")) |
32 |
(let ((p (make-package "TEST1"))) |
(let ((p (make-package "TEST1"))) |
33 |
(let ((sym (intern "FOO" p))) |
(let ((sym (intern "FOO" p))) |
34 |
(export (list sym) p) |
(export (list sym) p) |
35 |
(multiple-value-bind (sym2 status) |
(multiple-value-bind (sym2 status) |
36 |
(find-symbol "FOO" p) |
(find-symbol "FOO" p) |
37 |
(prog1 |
(prog1 |
38 |
(and sym2 |
(and sym2 |
39 |
(eqt (symbol-package sym2) p) |
(eqt (symbol-package sym2) p) |
40 |
(string= (symbol-name sym2) "FOO") |
(string= (symbol-name sym2) "FOO") |
41 |
(eqt sym sym2) |
(eqt sym sym2) |
42 |
(eqt status :external)) |
(eqt status :external)) |
43 |
(delete-package p)))))) |
(delete-package p)))))) |
44 |
t) |
t) |
45 |
|
|
46 |
(deftest export-3 |
(deftest export-3 |
47 |
(handler-case |
(handler-case |
48 |
(progn |
(progn |
49 |
(make-package "F") |
(make-package "F") |
50 |
(let ((sym (intern "FOO" "F"))) |
(let ((sym (intern "FOO" "F"))) |
51 |
(export sym #\F) |
(export sym #\F) |
52 |
(delete-package "F") |
(delete-package "F") |
53 |
t)) |
t)) |
54 |
(error (c) (delete-package "F") c)) |
(error (c) (delete-package "F") c)) |
55 |
t) |
t) |
56 |
|
|
57 |
;; |
;; |
60 |
;; user whether the symbol should be imported. |
;; user whether the symbol should be imported. |
61 |
;; |
;; |
62 |
(deftest export-4 |
(deftest export-4 |
63 |
(handler-case |
(handler-case |
64 |
(export 'b::bar "A") |
(export 'b::bar "A") |
65 |
(package-error () 'package-error) |
(package-error () 'package-error) |
66 |
(error (c) c)) |
(error (c) c)) |
67 |
package-error) |
package-error) |
68 |
|
|
69 |
;; |
;; |
72 |
;; is exporting a symbol with the same name. |
;; is exporting a symbol with the same name. |
73 |
;; |
;; |
74 |
(deftest export-5 |
(deftest export-5 |
75 |
(progn |
(progn |
76 |
(make-package "TEST1") |
(make-package "TEST1") |
77 |
(make-package "TEST2" :use '("TEST1")) |
(make-package "TEST2" :use '("TEST1")) |
78 |
(export (intern "X" "TEST2") "TEST2") |
(export (intern "X" "TEST2") "TEST2") |
79 |
(prog1 |
(prog1 |
80 |
(handler-case |
(handler-case |
81 |
(let ((sym (intern "X" "TEST1"))) |
(let ((sym (intern "X" "TEST1"))) |
82 |
(handler-case |
(handler-case |
83 |
(export sym "TEST1") |
(export sym "TEST1") |
84 |
(error (c) |
(error (c) |
85 |
(format t "Caught error in EXPORT-5: ~A~%" c) |
(format t "Caught error in EXPORT-5: ~A~%" c) |
86 |
'caught))) |
'caught))) |
87 |
(error (c) c)) |
(error (c) c)) |
88 |
(delete-package "TEST2") |
(delete-package "TEST2") |
89 |
(delete-package "TEST1"))) |
(delete-package "TEST1"))) |
90 |
caught) |
caught) |