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

Diff of /gcl/ansi-tests/package-name.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 22:03:24 2004 UTC
# Line 104  Line 104 
104                 (ignore-errors (package-name (package-name p))))))                 (ignore-errors (package-name (package-name p))))))
105    0)    0)
106    
107    ;;; Specialized sequence tests
108    
109    (defmacro def-package-name-test (test-name name-form expected-name-form)
110      `(deftest ,test-name
111         (let ((name ,name-form)
112               (expected-name ,expected-name-form))
113           (assert (string= name expected-name))
114           (safely-delete-package name)
115           (let ((p (make-package name :use nil)))
116             (equalt (package-name p) expected-name)))
117         t))
118    
119    (def-package-name-test package-name.16
120      (make-array 5 :element-type 'base-char :initial-contents "TEST1")
121      "TEST1")
122    
123    (def-package-name-test package-name.17
124      (make-array 10 :element-type 'base-char
125                  :fill-pointer 5
126                  :initial-contents "TEST1?????")
127      "TEST1")
128    
129    (def-package-name-test package-name.18
130      (make-array 10 :element-type 'character
131                  :fill-pointer 5
132                  :initial-contents "TEST1?????")
133      "TEST1")
134    
135    (def-package-name-test package-name.19
136      (make-array 5 :element-type 'base-char :adjustable t
137                  :initial-contents "TEST1")
138      "TEST1")
139    
140    (def-package-name-test package-name.20
141      (make-array 5 :element-type 'character :adjustable t
142                  :initial-contents "TEST1")
143      "TEST1")
144    
145    (def-package-name-test package-name.21
146      (let* ((etype 'base-char)
147             (name0 (make-array 10 :element-type etype
148                                :initial-contents "XXTEST1XXX")))
149        (make-array 5 :element-type etype :displaced-to name0
150                    :displaced-index-offset 2))
151      "TEST1")
152    
153    (def-package-name-test package-name.22
154      (let* ((etype 'character)
155             (name0 (make-array 10 :element-type etype
156                                :initial-contents "XXTEST1XXX")))
157        (make-array 5 :element-type etype :displaced-to name0
158                    :displaced-index-offset 2))
159      "TEST1")
160    
161    
162  (deftest package-name.error.1  (deftest package-name.error.1
163    (signals-error (package-name) program-error)    (signals-error (package-name) program-error)
164    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