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

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

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

revision 1.5 by pfdietz, Thu Oct 17 13:16:56 2002 UTC revision 1.6 by pfdietz, Thu Oct 24 03:21:50 2002 UTC
# Line 14  Line 14 
14  ;; we don't examine it here.  ;; we don't examine it here.
15  ;; Try several ways of specifying the package name.  ;; Try several ways of specifying the package name.
16  (deftest defpackage-1  (deftest defpackage-1
17    (handler-case    (loop
18     (loop     for n in '("H" #:|H| #\H) count
19      for n in '("H" #:|H| #\H) count     (not
20      (not      (progn
21       (progn        (ignore-errors (delete-package "H"))
22         (ignore-errors (delete-package "H"))        (let ((p (ignore-errors (eval `(defpackage ,n)))))
23         (let ((p (ignore-errors (eval `(defpackage ,n)))))          (and
24           (and           (packagep p)
25            (packagep p)           (equal (package-name p)              "H")
26            (equal (package-name p)              "H")           ;; (equal (package-use-list p)          nil)
27            ;; (equal (package-use-list p)          nil)           (equal (package-used-by-list p)      nil)
28            (equal (package-used-by-list p)      nil)           (equal (package-nicknames p)         nil)
29            (equal (package-nicknames p)         nil)           (equal (package-shadowing-symbols p) nil)
30            (equal (package-shadowing-symbols p) nil)           (null (documentation p t))
31            (null (documentation p t))           )))))
           )))))  
    (error (c) c))  
32    0)    0)
33    
34  ;; Test :nicknames option  ;; Test :nicknames option
# Line 365  Line 363 
363  (deftest defpackage-13  (deftest defpackage-13
364    (progn    (progn
365      (ignore-errors (delete-package "H"))      (ignore-errors (delete-package "H"))
366      (handler-case      (classify-error
367       (eval '(defpackage "H" (:use) (:size 10) (:size 20)))       (eval '(defpackage "H" (:use) (:size 10) (:size 20)))))
      (program-error () 'program-error)  
      (error (c) c)))  
368    program-error)    program-error)
369    
370  ;; Repeated documentation field should cause a program-error  ;; Repeated documentation field should cause a program-error
371  (deftest defpackage-14  (deftest defpackage-14
372    (progn    (progn
373      (ignore-errors (delete-package "H"))      (ignore-errors (delete-package "H"))
374      (handler-case      (classify-error
375       (eval '(defpackage "H" (:use)       (eval '(defpackage "H" (:use)
376                (:documentation "foo")                (:documentation "foo")
377                (:documentation "bar")))                (:documentation "bar")))))
      (program-error () 'program-error)  
      (error (c) c)))  
378    program-error)    program-error)
379    
380  ;; When a nickname refers to an existing package or nickname,  ;; When a nickname refers to an existing package or nickname,
# Line 389  Line 383 
383  (deftest defpackage-15  (deftest defpackage-15
384    (progn    (progn
385      (ignore-errors (delete-package "H"))      (ignore-errors (delete-package "H"))
386      (handler-case      (classify-error
387       (eval '(defpackage "H" (:use)       (eval '(defpackage "H" (:use)
388                (:nicknames "A")))                (:nicknames "A")))))
      (package-error () 'package-error)  
      (error (c) c)))  
389    package-error)    package-error)
390    
391  (deftest defpackage-16  (deftest defpackage-16
392    (progn    (progn
393      (ignore-errors (delete-package "H"))      (ignore-errors (delete-package "H"))
394      (handler-case      (classify-error
395       (eval '(defpackage "H" (:use)       (eval '(defpackage "H" (:use)
396                (:nicknames "Q")))                (:nicknames "Q")))))
      (package-error () 'package-error)  
      (error (c) c)))  
397    package-error)    package-error)
398    
399  ;; Names in :shadow, :shadowing-import-from, :import-from, and :intern  ;; Names in :shadow, :shadowing-import-from, :import-from, and :intern
# Line 411  Line 401 
401    
402  ;; :shadow and :shadowing-import-from  ;; :shadow and :shadowing-import-from
403  (deftest defpackage-17  (deftest defpackage-17
404    (ignore-errors    (progn
405      (ignore-errors (delete-package "H"))      (ignore-errors (delete-package "H"))
406      (ignore-errors (delete-package "G"))      (ignore-errors (delete-package "G"))
407      (eval '(defpackage "G" (:use) (:export "A")))      (eval '(defpackage "G" (:use) (:export "A")))
408      (handler-case      (classify-error
409       (eval '(defpackage "H" (:use)       (eval '(defpackage "H" (:use)
410                (:shadow "A")                (:shadow "A")
411                (:shadowing-import-from "G" "A")))                (:shadowing-import-from "G" "A")))))
      (program-error () 'program-error)  
      (error (c) c)))  
412    program-error)    program-error)
413    
414  ;; :shadow and :import-from  ;; :shadow and :import-from
415  (deftest defpackage-18  (deftest defpackage-18
416    (ignore-errors    (progn
417      (ignore-errors (delete-package "H"))      (ignore-errors (delete-package "H"))
418      (ignore-errors (delete-package "G"))      (ignore-errors (delete-package "G"))
419      (eval '(defpackage "G" (:use) (:export "A")))      (eval '(defpackage "G" (:use) (:export "A")))
420      (handler-case      (classify-error
421       (eval '(defpackage "H" (:use)       (eval '(defpackage "H" (:use)
422                (:shadow "A")                (:shadow "A")
423                (:import-from "G" "A")))                (:import-from "G" "A")))))
      (program-error () 'program-error)  
      (error (c) c)))  
424    program-error)    program-error)
425    
426  ;; :shadow and :intern  ;; :shadow and :intern
427  (deftest defpackage-19  (deftest defpackage-19
428    (progn    (progn
429      (ignore-errors (delete-package "H"))      (ignore-errors (delete-package "H"))
430      (handler-case      (classify-error
431       (eval '(defpackage "H" (:use)       (eval '(defpackage "H" (:use)
432                (:shadow "A")                (:shadow "A")
433                (:intern "A")))                (:intern "A")))))
      (program-error () 'program-error)  
      (error (c) c)))  
434    program-error)    program-error)
435    
436  ;; :shadowing-import-from and :import-from  ;; :shadowing-import-from and :import-from
437  (deftest defpackage-20  (deftest defpackage-20
438    (ignore-errors    (progn
439      (ignore-errors (delete-package "H"))      (ignore-errors (delete-package "H"))
440      (ignore-errors (delete-package "G"))      (ignore-errors (delete-package "G"))
441      (eval '(defpackage "G" (:use) (:export "A")))      (eval '(defpackage "G" (:use) (:export "A")))
442      (handler-case      (classify-error
443       (eval '(defpackage "H" (:use)       (eval '(defpackage "H" (:use)
444                (:shadowing-import-from "G" "A")                (:shadowing-import-from "G" "A")
445                (:import-from "G" "A")))                (:import-from "G" "A")))))
      (program-error () 'program-error)  
      (error (c) c)))  
446    program-error)    program-error)
447    
448  ;; :shadowing-import-from and :intern  ;; :shadowing-import-from and :intern
449  (deftest defpackage-21  (deftest defpackage-21
450    (ignore-errors    (progn
451      (ignore-errors (delete-package "H"))      (ignore-errors (delete-package "H"))
452      (ignore-errors (delete-package "G"))      (ignore-errors (delete-package "G"))
453      (eval '(defpackage "G" (:use) (:export "A")))      (eval '(defpackage "G" (:use) (:export "A")))
454      (handler-case      (classify-error
455       (eval '(defpackage "H" (:use)       (eval '(defpackage "H" (:use)
456                (:shadowing-import-from "G" "A")                (:shadowing-import-from "G" "A")
457                (:intern "A")))                (:intern "A")))))
      (program-error () 'program-error)  
      (error (c) c)))  
458    program-error)    program-error)
459    
460  ;; :import-from and :intern  ;; :import-from and :intern
461  (deftest defpackage-22  (deftest defpackage-22
462    (ignore-errors    (progn
463      (ignore-errors (delete-package "H"))      (ignore-errors (delete-package "H"))
464      (ignore-errors (delete-package "G"))      (ignore-errors (delete-package "G"))
465      (eval '(defpackage "G" (:use) (:export "A")))      (eval '(defpackage "G" (:use) (:export "A")))
466      (handler-case      (classify-error
467       (eval '(defpackage "H" (:use)       (eval '(defpackage "H" (:use)
468                (:import-from "G" "A")                (:import-from "G" "A")
469                (:intern "A")))                (:intern "A")))))
      (program-error () 'program-error)  
      (error (c) c)))  
470    program-error)    program-error)
471    
472  ;; Names given to :export and :intern must be disjoint,  ;; Names given to :export and :intern must be disjoint,
473  ;;  otherwise signal a program-error  ;;  otherwise signal a program-error
474  (deftest defpackage-23  (deftest defpackage-23
475    (ignore-errors    (progn
476      (ignore-errors (delete-package "H"))      (ignore-errors (delete-package "H"))
477      (handler-case      (classify-error
478       (eval '(defpackage "H" (:use)       (eval '(defpackage "H" (:use)
479                (:export "A")                (:export "A")
480                (:intern "A")))                (:intern "A")))))
      (program-error () 'program-error)  
      (error (c) c)))  
481    program-error)    program-error)
482    
483  ;; :shadowing-import-from signals a correctable package-error  ;; :shadowing-import-from signals a correctable package-error
484  ;;  if the symbol is not accessible in the named package  ;;  if the symbol is not accessible in the named package
485  (deftest defpackage-24  (deftest defpackage-24
486    (ignore-errors    (progn
487      (ignore-errors (delete-package "H"))      (ignore-errors (delete-package "H"))
488      (ignore-errors (delete-package "G"))      (ignore-errors (delete-package "G"))
489      (eval '(defpackage "G" (:use)))      (eval '(defpackage "G" (:use)))
490      (handler-case      (handle-non-abort-restart
491       (eval '(defpackage "H" (:shadowing-import-from "G" "NOT-THERE")))       (eval '(defpackage "H" (:shadowing-import-from
492       (package-error (c)                               "G" "NOT-THERE")))))
                     (if (position 'abort (compute-restarts c)  
                                   :key #'restart-name :test-not #'eq)  
                         'success  
                       'fail))  
      (error (c) c)))  
493    success)    success)
494    
495  ;; :import-from signals a correctable package-error if a symbol with  ;; :import-from signals a correctable package-error if a symbol with
496  ;; the indicated name is not accessible in the package indicated  ;; the indicated name is not accessible in the package indicated
497    
498  (deftest defpackage-25  (deftest defpackage-25
499    (ignore-errors    (progn
500      (ignore-errors (delete-package "H"))      (ignore-errors (delete-package "H"))
501      (ignore-errors (delete-package "G"))      (ignore-errors (delete-package "G"))
502      (eval '(defpackage "G" (:use)))      (eval '(defpackage "G" (:use)))
503      (handler-case      (handle-non-abort-restart
504       (eval '(defpackage "H" (:import-from "G" "NOT-THERE")))       (eval '(defpackage "H" (:import-from "G" "NOT-THERE")))))
      (package-error (c)  
                     (if (position 'abort (compute-restarts c)  
                                   :key #'restart-name :test-not #'eq)  
                         'success  
                       'fail))  
      (error (c) c)))  
505    success)    success)
506    
507  ;; A big test that combines all the options to defpackage  ;; A big test that combines all the options to defpackage

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