/[gcl]/gcl/ansi-tests/shadow.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/shadow.lsp

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

revision 1.1 by pfdietz, Sun Feb 22 13:33:59 2004 UTC revision 1.2 by pfdietz, Sun Aug 29 15:44:23 2004 UTC
# Line 16  Line 16 
16          (safely-delete-package "TEST4")          (safely-delete-package "TEST4")
17          (handler-case          (handler-case
18           (let* ((p1 (prog1           (let* ((p1 (prog1
19                          (make-package "TEST4")                          (make-package "TEST4" :use nil)
20                        (export (intern "A" "TEST4") "TEST4")))                        (export (intern "A" "TEST4") "TEST4")))
21                  (p2 (make-package "TEST5" :use '("TEST4")))                  (p2 (make-package "TEST5" :use '("TEST4")))
22                  (r1 (package-shadowing-symbols "TEST4"))                  (r1 (package-shadowing-symbols "TEST4"))
# Line 56  Line 56 
56      (safely-delete-package "G")      (safely-delete-package "G")
57      (handler-case      (handler-case
58       (let* ((p1 (prog1       (let* ((p1 (prog1
59                      (make-package "G")                      (make-package "G" :use nil)
60                    (export (intern "A" "G") "G")))                    (export (intern "A" "G") "G")))
61              (p2 (make-package "H" :use '("G")))              (p2 (make-package "H" :use '("G")))
62              (r1 (package-shadowing-symbols "G"))              (r1 (package-shadowing-symbols "G"))
# Line 94  Line 94 
94      (safely-delete-package "G")      (safely-delete-package "G")
95      (handler-case      (handler-case
96       (let* ((p1 (prog1       (let* ((p1 (prog1
97                      (make-package "G")                      (make-package "G" :use nil)
98                    (export (intern "A" "G") "G")))                    (export (intern "A" "G") "G")))
99              (p2 (make-package "H" :use '("G")))              (p2 (make-package "H" :use '("G")))
100              (r1 (package-shadowing-symbols "G"))              (r1 (package-shadowing-symbols "G"))
# Line 131  Line 131 
131        (handler-case        (handler-case
132         (progn         (progn
133           (safely-delete-package :G)           (safely-delete-package :G)
134           (make-package :G)           (make-package :G :use nil)
135           (let ((s1 (intern "X" :G)))           (let ((s1 (intern "X" :G)))
136             (shadow "X" :G)             (shadow "X" :G)
137             (multiple-value-bind* (s2 kind)             (multiple-value-bind* (s2 kind)
# Line 152  Line 152 
152         (progn         (progn
153           (safely-delete-package :H)           (safely-delete-package :H)
154           (safely-delete-package :G)           (safely-delete-package :G)
155           (make-package :G)           (make-package :G :use nil)
156           (export (intern "X" :G) :G)           (export (intern "X" :G) :G)
157           (make-package :H :use '("G"))           (make-package :H :use '("G"))
158           (shadow "X" :H)           (shadow "X" :H)
# Line 174  Line 174 
174        (handler-case        (handler-case
175         (progn         (progn
176           (safely-delete-package :G)           (safely-delete-package :G)
177           (make-package :G)           (make-package :G :use nil)
178           (shadow '("X" "Y" |Z|) :G)           (shadow '("X" "Y" |Z|) :G)
179           (let ((results           (let ((results
180                  (append (multiple-value-list                  (append (multiple-value-list
# Line 202  Line 202 
202        (handler-case        (handler-case
203         (let ((i 0) x y)         (let ((i 0) x y)
204           (safely-delete-package :G)           (safely-delete-package :G)
205           (make-package :G)           (make-package :G :use nil)
206           (shadow (progn (setf x (incf i)) '(#\X #\Y))           (shadow (progn (setf x (incf i)) '(#\X #\Y))
207                   (progn (setf y (incf i)) :G))                   (progn (setf y (incf i)) :G))
208           (let ((results           (let ((results
# Line 222  Line 222 
222      (safely-delete-package :G))      (safely-delete-package :G))
223    (2 1 2 "X" :internal "Y" :internal 2))    (2 1 2 "X" :internal "Y" :internal 2))
224    
225    ;;; Specialized string tests
226    
227    (deftest shadow.8
228      (prog1
229          (handler-case
230           (progn
231             (safely-delete-package :G)
232             (make-package :G :use nil)
233             (let* ((name (make-array '(1) :initial-contents "X"
234                                      :element-type 'base-char))
235                    (s1 (intern name :G)))
236               (shadow name :G)
237               (multiple-value-bind* (s2 kind)
238                   (find-symbol "X" :G)
239                 (list (eqt s1 s2)
240                       (symbol-name s2)
241                       (package-name (symbol-package s2))
242                       kind))))
243           (error (c) c))
244        (safely-delete-package "G"))
245      (t "X" "G" :internal))
246    
247    (deftest shadow.9
248      (prog1
249          (handler-case
250           (progn
251             (safely-delete-package :G)
252             (make-package :G :use nil)
253             (let* ((name (make-array '(3) :initial-contents "XYZ"
254                                      :fill-pointer 1
255                                      :element-type 'character))
256                    (s1 (intern name :G)))
257               (shadow name :G)
258               (multiple-value-bind* (s2 kind)
259                   (find-symbol "X" :G)
260                 (list (eqt s1 s2)
261                       (symbol-name s2)
262                       (package-name (symbol-package s2))
263                       kind))))
264           (error (c) c))
265        (safely-delete-package "G"))
266      (t "X" "G" :internal))
267    
268    (deftest shadow.10
269      (prog1
270          (handler-case
271           (progn
272             (safely-delete-package :G)
273             (make-package :G :use nil)
274             (let* ((name (make-array '(1) :initial-contents "X"
275                                      :adjustable t
276                                      :element-type 'base-char))
277                    (s1 (intern name :G)))
278               (shadow name :G)
279               (multiple-value-bind* (s2 kind)
280                   (find-symbol "X" :G)
281                 (list (eqt s1 s2)
282                       (symbol-name s2)
283                       (package-name (symbol-package s2))
284                       kind))))
285           (error (c) c))
286        (safely-delete-package "G"))
287      (t "X" "G" :internal))
288    
289    
290    
291    
292  (deftest shadow.error.1  (deftest shadow.error.1
293    (signals-error (shadow) program-error)    (signals-error (shadow) program-error)
294    t)    t)

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

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