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

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

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

revision 1.1 by pfdietz, Sun Feb 22 13:33:58 2004 UTC revision 1.2 by pfdietz, Sun Aug 29 15:44:23 2004 UTC
# Line 260  Line 260 
260          (safely-delete-package p))))          (safely-delete-package p))))
261    t)    t)
262    
263    ;;; Specialized sequences as designators
264    
265    ;;; The package name being a specialized sequence
266    
267    (defmacro def-make-package-test1 (test-name name-form)
268      `(deftest ,test-name
269         (let ((name ,name-form))
270           (assert (string= name "TEST1"))
271           (safely-delete-package "TEST1")
272           (let ((p (ignore-errors (make-package name))))
273             (prog1
274                 (and (packagep p)
275                      (equalt (package-name p) "TEST1")
276                      (equalt (package-nicknames p) nil)
277                      (equalt (package-used-by-list p) nil))
278               (safely-delete-package p))))
279         t))
280    
281    (def-make-package-test1 make-package.14
282      (make-array 5 :initial-contents "TEST1"
283                  :element-type 'base-char))
284    
285    (def-make-package-test1 make-package.15
286      (make-array 12 :initial-contents "TEST1xxxyyyz"
287                  :fill-pointer 5
288                  :element-type 'base-char))
289    
290    (def-make-package-test1 make-package.16
291      (make-array 12 :initial-contents "TEST1xxxyyyz"
292                  :fill-pointer 5
293                  :element-type 'character))
294    
295    (def-make-package-test1 make-package.17
296      (make-array 5 :initial-contents "TEST1"
297                  :adjustable t
298                  :element-type 'base-char))
299    
300    (def-make-package-test1 make-package.18
301      (make-array 5 :initial-contents "TEST1"
302                  :adjustable t
303                  :element-type 'character))
304    
305    (def-make-package-test1 make-package.19
306      (let* ((etype 'base-char)
307             (name0 (make-array 10 :initial-contents "xxTEST1yyy"
308                                :element-type etype)))
309        (make-array 5 :element-type etype
310                    :displaced-to name0
311                    :displaced-index-offset 2)))
312    
313    (def-make-package-test1 make-package.20
314      (let* ((etype 'character)
315             (name0 (make-array 10 :initial-contents "xxTEST1yyy"
316                                :element-type etype)))
317        (make-array 5 :element-type etype
318                    :displaced-to name0
319                    :displaced-index-offset 2)))
320    
321    ;;; Nicknames being specialized sequences
322    
323    (defmacro def-make-package-test2 (test-name name-form)
324      `(deftest ,test-name
325         (let ((name ,name-form)
326               (nickname "TEST1-NICKNAME"))
327           (safely-delete-package "TEST1")
328           (safely-delete-package nickname)
329           (let ((p (make-package name :nicknames (list nickname))))
330             (prog1
331                 (and (packagep p)
332                      (equalt (package-name p) "TEST1")
333                      (equalt (package-nicknames p) (list nickname))
334                      (equalt (package-used-by-list p) nil))
335               (safely-delete-package p))))
336         t))
337    
338    (def-make-package-test2 make-package.21
339      (make-array 5 :initial-contents "TEST1"
340                  :element-type 'base-char))
341    
342    (def-make-package-test2 make-package.22
343      (make-array 12 :initial-contents "TEST1xxxyyyz"
344                  :fill-pointer 5
345                  :element-type 'base-char))
346    
347    (def-make-package-test2 make-package.23
348      (make-array 12 :initial-contents "TEST1xxxyyyz"
349                  :fill-pointer 5
350                  :element-type 'character))
351    
352    (def-make-package-test2 make-package.24
353      (make-array 5 :initial-contents "TEST1"
354                  :adjustable t
355                  :element-type 'base-char))
356    
357    (def-make-package-test2 make-package.25
358      (make-array 5 :initial-contents "TEST1"
359                  :adjustable t
360                  :element-type 'character))
361    
362    (def-make-package-test2 make-package.26
363      (let* ((etype 'base-char)
364             (name0 (make-array 10 :initial-contents "xxTEST1yyy"
365                                :element-type etype)))
366        (make-array 5 :element-type etype
367                    :displaced-to name0
368                    :displaced-index-offset 2)))
369    
370    (def-make-package-test2 make-package.27
371      (let* ((etype 'character)
372             (name0 (make-array 10 :initial-contents "xxTEST1yyy"
373                                :element-type etype)))
374        (make-array 5 :element-type etype
375                    :displaced-to name0
376                    :displaced-index-offset 2)))
377    
378    ;;; USE names being specialized sequences
379    
380    (defmacro def-make-package-test3 (test-name name-form)
381      `(deftest ,test-name
382         (let ((name ,name-form))
383           (safely-delete-package "TEST1")
384           (assert (find-package name))
385           (let ((p (ignore-errors (make-package "TEST1" :use (list name)))))
386             (prog1
387                 (and (packagep p)
388                      (equalt (package-name p) "TEST1")
389                      (equalt (package-nicknames p) nil)
390                      (equalt (package-use-list p) (list (find-package name)))
391                      (equalt (package-used-by-list p) nil))
392               (safely-delete-package p))))
393         t))
394    
395    (def-make-package-test3 make-package.28
396      (make-array 1 :initial-contents "A" :element-type 'base-char))
397    
398    (def-make-package-test3 make-package.29
399      (make-array 8 :initial-contents "Axxxyyyz"
400                  :fill-pointer 1
401                  :element-type 'base-char))
402    
403    (def-make-package-test3 make-package.30
404      (make-array 8 :initial-contents "Axxxyyyz"
405                  :fill-pointer 1
406                  :element-type 'character))
407    
408    (def-make-package-test3 make-package.31
409      (make-array 1 :initial-contents "A"
410                  :adjustable t
411                  :element-type 'base-char))
412    
413    (def-make-package-test3 make-package.32
414      (make-array 1 :initial-contents "A"
415                  :adjustable t
416                  :element-type 'character))
417    
418    (def-make-package-test3 make-package.33
419      (let* ((etype 'base-char)
420             (name0 (make-array 10 :initial-contents "xxAyyy0123"
421                                :element-type etype)))
422        (make-array 1 :element-type etype
423                    :displaced-to name0
424                    :displaced-index-offset 2)))
425    
426    (def-make-package-test3 make-package.34
427      (let* ((etype 'character)
428             (name0 (make-array 10 :initial-contents "xxAzzzzyyy"
429                                :element-type etype)))
430        (make-array 1 :element-type etype
431                    :displaced-to name0
432                    :displaced-index-offset 2)))
433    
434  ;; Signal a continuable error if the package or any nicknames  ;; Signal a continuable error if the package or any nicknames
435  ;; exist as packages or nicknames of packages  ;; exist as packages or nicknames of packages
436    

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