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

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

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

revision 1.5 by pfdietz, Fri Jan 24 04:22:54 2003 UTC revision 1.6 by pfdietz, Sat Feb 15 05:11:11 2003 UTC
# Line 12  Line 12 
12    
13  ;; Simple unintern of an internal symbol, package explicitly  ;; Simple unintern of an internal symbol, package explicitly
14  ;; given as a package object  ;; given as a package object
15  (deftest unintern-1  (deftest unintern.1
16    (progn    (progn
17      (safely-delete-package "H")      (safely-delete-package "H")
18      (prog1      (prog1
19          (let ((p (make-package "H")))          (let ((p (make-package "H"))
20                  (i 0) x y)
21            (intern "FOO" p)            (intern "FOO" p)
22            (multiple-value-bind* (sym access)            (multiple-value-bind*
23                (find-symbol "FOO" p)             (sym access)
24              (and             (find-symbol "FOO" p)
25               (eqt access :internal)             (and
26               (unintern sym p)              (eqt access :internal)
27               (null (symbol-package sym))              (unintern (progn (setf x (incf i)) sym)
28               (not (find-symbol "FOO" p)))))                        (progn (setf y (incf i)) p))
29                (eql i 2) (eql x 1) (eql y 2)
30                (null (symbol-package sym))
31                (not (find-symbol "FOO" p)))))
32        (safely-delete-package "H")))        (safely-delete-package "H")))
33    t)    t)
34    
35  ;; Simple unintern, package taken from the *PACKAGES*  ;; Simple unintern, package taken from the *PACKAGES*
36  ;; special variable (should this have unwind protect?)  ;; special variable (should this have unwind protect?)
37  (deftest unintern-2  (deftest unintern.2
38    (progn    (progn
39      (safely-delete-package "H")      (safely-delete-package "H")
40      (prog1      (prog1
# Line 48  Line 52 
52    t)    t)
53    
54  ;; Simple unintern, package given as string  ;; Simple unintern, package given as string
55  (deftest unintern-3  (deftest unintern.3
56    (progn    (progn
57      (safely-delete-package "H")      (safely-delete-package "H")
58      (prog1      (prog1
# Line 65  Line 69 
69    t)    t)
70    
71  ;; Simple unintern, package given as symbol  ;; Simple unintern, package given as symbol
72  (deftest unintern-4  (deftest unintern.4
73    (progn    (progn
74      (safely-delete-package "H")      (safely-delete-package "H")
75      (prog1      (prog1
# Line 82  Line 86 
86    t)    t)
87    
88  ;; Simple unintern, package given as character  ;; Simple unintern, package given as character
89  (deftest unintern-5  (deftest unintern.5
90    (handler-case    (handler-case
91     (progn     (progn
92       (safely-delete-package "H")       (safely-delete-package "H")
# Line 105  Line 109 
109    
110  ;; Unintern an external symbol that is also inherited  ;; Unintern an external symbol that is also inherited
111    
112  (deftest unintern-6  (deftest unintern.6
113    (handler-case    (handler-case
114     (progn     (progn
115       (safely-delete-package "H")       (safely-delete-package "H")
# Line 135  Line 139 
139    
140  ;; unintern a symbol that is shadowing another symbol  ;; unintern a symbol that is shadowing another symbol
141    
142  (deftest unintern-7  (deftest unintern.7
143      (block failed      (block failed
144        (safely-delete-package "H")        (safely-delete-package "H")
145        (safely-delete-package "G")        (safely-delete-package "G")
# Line 164  Line 168 
168    
169  ;; Error situation: when the symbol is uninterned, creates  ;; Error situation: when the symbol is uninterned, creates
170  ;; a name conflict from two used packages  ;; a name conflict from two used packages
171  (deftest unintern-8  (deftest unintern.8
172    (block failed    (block failed
173      (safely-delete-package "H")      (safely-delete-package "H")
174      (safely-delete-package "G1")      (safely-delete-package "G1")
# Line 200  Line 204 
204  ;; Now, inherit the same symbol through two intermediate  ;; Now, inherit the same symbol through two intermediate
205  ;; packages.  No error should occur when the shadowing  ;; packages.  No error should occur when the shadowing
206  ;; is removed  ;; is removed
207  (deftest unintern-9  (deftest unintern.9
208    (block failed    (block failed
209      (safely-delete-package "H")      (safely-delete-package "H")
210      (safely-delete-package "G1")      (safely-delete-package "G1")

Legend:
Removed from v.1.5  
changed lines
  Added in v.1.6

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