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

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

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

File size: 2.6 KB
RevLine 
[8991]1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sat Apr 25 07:59:45 1998
4;;;; Contains: Tests of EXPORT
5
6(in-package :cl-test)
7(declaim (optimize (safety 3)))
8
9;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10;;; export
11
12(deftest export.1
13  (let ((return-value nil))
14    (safely-delete-package "TEST1")
15    (let ((p (make-package "TEST1")))
16      (let ((sym (intern "FOO" p))
17            (i 0) x y)
18        (setf return-value (export (progn (setf x (incf i)) sym)
19                                   (progn (setf y (incf i)) p)))
20        (multiple-value-bind* (sym2 status)
21            (find-symbol "FOO" p)
22          (prog1
23              (and sym2
24                   (eql i 2)
25                   (eql x 1)
26                   (eql y 2)
27                   (eqt (symbol-package sym2) p)
28                   (string= (symbol-name sym2) "FOO")
29                   (eqt sym sym2)
30                   (eqt status :external))
31            (delete-package p)))))
32    return-value)
33  t)
34
35(deftest export.2
36  (progn
37    (safely-delete-package "TEST1")
38    (let ((p (make-package "TEST1")))
39      (let ((sym (intern "FOO" p)))
40        (export (list sym) p)
41        (multiple-value-bind* (sym2 status)
42            (find-symbol "FOO" p)
43          (prog1
44              (and sym2
45                   (eqt (symbol-package sym2) p)
46                   (string= (symbol-name sym2) "FOO")
47                   (eqt sym sym2)
48                   (eqt status :external))
49            (delete-package p))))))
50  t)
51
52(deftest export.3
53  (handler-case
54   (progn
55     (safely-delete-package "F")
56     (make-package "F")
57     (let ((sym (intern "FOO" "F")))
58       (export sym #\F)
59       (delete-package "F")
60       t))
61   (error (c) (safely-delete-package "F") c))
62  t)
63
64;;
65;; When a symbol not in a package is exported, export
66;; should signal a correctable package-error asking the
67;; user whether the symbol should be imported.
68;;
69(deftest export.4
70  (progn
71    (set-up-packages)
72    (handler-case
73     (export 'b::bar "A")
74     (package-error () 'package-error)
75     (error (c) c)))
76  package-error)
77
78;;
79;; Test that it catches an attempt to export a symbol
80;; from a package that is used by another package that
81;; is exporting a symbol with the same name.
82;;
83(deftest export.5
84  (progn
85    (safely-delete-package "TEST1")
86    (safely-delete-package "TEST2")
87    (make-package "TEST1")
88    (make-package "TEST2" :use '("TEST1"))
89    (export (intern "X" "TEST2") "TEST2")
90    (prog1
91        (handler-case
92         (let ((sym (intern "X" "TEST1")))
93           (handler-case
94            (export sym "TEST1")
95            (error (c)
96                   (format t "Caught error in EXPORT.5: ~A~%" c)
97                   'caught)))
98         (error (c) c))
99      (delete-package "TEST2")
100      (delete-package "TEST1")))
101  caught)
102
103(deftest export.error.1
104  (signals-error (export) program-error)
105  t)
106
107(deftest export.error.2
108  (signals-error (export 'X "CL-TEST" NIL) program-error)
109  t)
Note: See TracBrowser for help on using the repository browser.