/[gcl]/gcl/ansi-tests/use-package.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/use-package.lsp

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

revision 1.2 by pfdietz, Tue Jun 22 12:40:35 2004 UTC revision 1.3 by pfdietz, Sun Aug 29 22:03:24 2004 UTC
# Line 197  Line 197 
197          (safely-delete-package ph))))          (safely-delete-package ph))))
198    t)    t)
199    
200  ;; Also: need to check that *PACKAGE* is used as a default  ;; Check that *PACKAGE* is used as a default
201    
202    (deftest use-package.7
203      (let ((user-name "H")
204            (used-name "G"))
205        (safely-delete-package user-name)
206        (safely-delete-package used-name)
207        (let* ((pused (make-package used-name :use nil))
208               (puser (make-package user-name :use nil))
209               (sym1 (intern "FOO" pused)))
210          (and
211           (eqt (export sym1 pused) t)
212           (null (package-used-by-list pused))
213           (null (package-used-by-list puser))
214           (null (package-use-list pused))
215           (null (package-use-list puser))
216           (eqt (let ((*package* puser)) (use-package pused)) t)  ;; user will use used
217           (multiple-value-bind (sym2 access)
218               (find-symbol "FOO" puser)
219             (and
220              (eqt access :inherited)
221              (eqt sym1 sym2)))
222           (equal (package-use-list puser) (list pused))
223           (equal (package-used-by-list pused) (list puser))
224           (null (package-use-list pused))
225           (null (package-used-by-list puser))
226           (eqt (unuse-package pused puser) t)
227           (null (find-symbol "FOO" puser)))))
228      t)
229    
230    ;;; Tests for specialized sequence arguments
231    
232    (defmacro def-use-package-test (test-name &key (user "H") (used "G"))
233      `(deftest ,test-name
234         (let ((user-name ,user)
235               (used-name ,used))
236           (safely-delete-package user-name)
237           (safely-delete-package used-name)
238           (let* ((pused (make-package used-name :use nil))
239                  (puser (make-package user-name :use nil))
240                  (sym1 (intern "FOO" pused)))
241             (and
242              (eqt (export sym1 pused) t)
243              (null (package-used-by-list pused))
244              (null (package-used-by-list puser))
245              (null (package-use-list pused))
246              (null (package-use-list puser))
247              (eqt (let ((*package* puser)) (use-package pused)) t)  ;; user will use used
248              (multiple-value-bind (sym2 access)
249                  (find-symbol "FOO" puser)
250                (and
251                 (eqt access :inherited)
252                 (eqt sym1 sym2)))
253              (equal (package-use-list puser) (list pused))
254              (equal (package-used-by-list pused) (list puser))
255              (null (package-use-list pused))
256              (null (package-used-by-list puser))
257              (eqt (unuse-package pused puser) t)
258              (null (find-symbol "FOO" puser)))))
259         t))
260    
261    ;;; Specialized user package designator
262    
263    (def-use-package-test use-package.10
264      :user (make-array 5 :initial-contents "TEST1" :element-type 'base-char))
265    
266    (def-use-package-test use-package.11
267      :user (make-array 10 :initial-contents "TEST1ABCDE"
268                        :fill-pointer 5 :element-type 'base-char))
269    
270    (def-use-package-test use-package.12
271      :user (make-array 10 :initial-contents "TEST1ABCDE"
272                        :fill-pointer 5 :element-type 'character))
273    
274    (def-use-package-test use-package.13
275      :user (make-array 5 :initial-contents "TEST1"
276                        :adjustable t :element-type 'base-char))
277    
278    (def-use-package-test use-package.14
279      :user (make-array 5 :initial-contents "TEST1"
280                        :adjustable t :element-type 'character))
281    
282    (def-use-package-test use-package.15
283      :user (let* ((etype 'base-char)
284                   (name0 (make-array 10 :element-type etype
285                                      :initial-contents "xxxxxTEST1")))
286              (make-array 5 :element-type etype
287                          :displaced-to name0
288                          :displaced-index-offset 5)))
289    
290    (def-use-package-test use-package.16
291      :user
292      (let* ((etype 'character)
293             (name0 (make-array 10 :element-type etype
294                                :initial-contents "xxxxxTEST1")))
295        (make-array 5 :element-type etype
296                    :displaced-to name0
297                    :displaced-index-offset 5)))
298    
299    ;;; Specialed used package designator
300    
301    (def-use-package-test use-package.17
302      :used (make-array 5 :initial-contents "TEST1" :element-type 'base-char))
303    
304    (def-use-package-test use-package.18
305      :used (make-array 10 :initial-contents "TEST1ABCDE"
306                        :fill-pointer 5 :element-type 'base-char))
307    
308    (def-use-package-test use-package.19
309      :used (make-array 10 :initial-contents "TEST1ABCDE"
310                        :fill-pointer 5 :element-type 'character))
311    
312    (def-use-package-test use-package.20
313      :used (make-array 5 :initial-contents "TEST1"
314                        :adjustable t :element-type 'base-char))
315    
316    (def-use-package-test use-package.21
317      :used (make-array 5 :initial-contents "TEST1"
318                        :adjustable t :element-type 'character))
319    
320    (def-use-package-test use-package.22
321      :used (let* ((etype 'base-char)
322                   (name0 (make-array 10 :element-type etype
323                                      :initial-contents "xxxxxTEST1")))
324              (make-array 5 :element-type etype
325                          :displaced-to name0
326                          :displaced-index-offset 5)))
327    
328    (def-use-package-test use-package.23
329      :used
330      (let* ((etype 'character)
331             (name0 (make-array 10 :element-type etype
332                                :initial-contents "xxxxxTEST1")))
333        (make-array 5 :element-type etype
334                    :displaced-to name0
335                    :displaced-index-offset 5)))
336    
337  (deftest use-package.error.1  (deftest use-package.error.1
338    (signals-error (use-package) program-error)    (signals-error (use-package) program-error)

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