/[gcl]/gcl/ansi-tests/packages-05.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/packages-05.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.2 by pfdietz, Thu Oct 17 13:16:56 2002 UTC revision 1.3 by pfdietz, Fri Oct 18 11:58:46 2002 UTC
# Line 10  Line 10 
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  ;;  ;;
# Line 60  Line 60 
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  ;;  ;;
# Line 72  Line 72 
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)

Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26