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

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

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

revision 1.3 by pfdietz, Wed Jan 22 02:44:51 2003 UTC revision 1.4 by pfdietz, Wed Jan 29 00:42:25 2003 UTC
# Line 40  Line 40 
40        warning))        warning))
41    
42  (defvar *condition-objects*  (defvar *condition-objects*
43      (loop    (loop for tp in *condition-types* append
44          for tp in *condition-types* append          (handler-case (list (make-condition tp))
45            (handler-case                        (error () nil))))
               (list (make-condition tp))  
             (error () nil))))  
46    
47  (defvar *standard-package-names*  (defvar *standard-package-names*
48      '("COMMON-LISP" "COMMON-LISP-USER" "KEYWORD"))    '("COMMON-LISP" "COMMON-LISP-USER" "KEYWORD"))
49    
50  (defvar *package-objects*  (defvar *package-objects*
51      (loop    (loop for pname in *standard-package-names* append
52          for pname in *standard-package-names* append          (handler-case (let ((pkg (find-package pname)))
53            (handler-case                          (and pkg (list pkg)))
54                (let ((pkg (find-package pname)))                        (error () nil))))
                 (and pkg (list pkg)))  
             (error () nil))))  
55    
56  (defvar *integers*  (defvar *integers*
57      (remove-duplicates      (remove-duplicates
# Line 76  Line 72 
72    
73  (defvar *floats*  (defvar *floats*
74      (list      (list
75         PI
76       MOST-POSITIVE-SHORT-FLOAT LEAST-POSITIVE-SHORT-FLOAT       MOST-POSITIVE-SHORT-FLOAT LEAST-POSITIVE-SHORT-FLOAT
77       LEAST-POSITIVE-NORMALIZED-SHORT-FLOAT MOST-POSITIVE-DOUBLE-FLOAT       LEAST-POSITIVE-NORMALIZED-SHORT-FLOAT MOST-POSITIVE-DOUBLE-FLOAT
78       LEAST-POSITIVE-DOUBLE-FLOAT LEAST-POSITIVE-NORMALIZED-DOUBLE-FLOAT       LEAST-POSITIVE-DOUBLE-FLOAT LEAST-POSITIVE-NORMALIZED-DOUBLE-FLOAT
# Line 157  Line 154 
154              do (let ((c (code-char i)))              do (let ((c (code-char i)))
155                   (when c                   (when c
156                     (setf (elt s i) c))))                     (setf (elt s i) c))))
157          s))))          s)
158          )))
159    
160  (defvar *conses*  (defvar *conses*
161      (list      (list
# Line 180  Line 178 
178  (defvar *booleans* '(nil t))  (defvar *booleans* '(nil t))
179  (defvar *keywords* '(:a :b :|| :|a| :|1234|))  (defvar *keywords* '(:a :b :|| :|a| :|1234|))
180  (defvar *uninterned-symbols*  (defvar *uninterned-symbols*
181      (list '#:nil '#:t '#:foo    (list '#:nil '#:t '#:foo '#:||))
           #-CMU '#:||  
           ))  
182  (defvar *cl-test-symbols*  (defvar *cl-test-symbols*
183      `(,(intern "a" :cl-test)      `(,(intern "a" :cl-test)
184        ,(intern "" :cl-test)        ,(intern "" :cl-test)
# Line 213  Line 209 
209    
210  (defvar *array-dimensions*  (defvar *array-dimensions*
211      (loop      (loop
212          for i from 1 to 8 collect          for i from 0 to 8 collect
213            (loop for j from 1 to i collect 2)))            (loop for j from 1 to i collect 2)))
214    
215    (defvar *default-array-target* (make-array '(300)))
216    
217  (defvar *arrays*  (defvar *arrays*
218      (append      (append
219       (list (make-array '10))       (list (make-array '10))
# Line 233  Line 231 
231       (loop       (loop
232         for d in *array-dimensions*         for d in *array-dimensions*
233           collect (make-array d :adjustable t))           collect (make-array d :adjustable t))
234    
235         ;; Displaced arrays
236         (loop
237          for d in *array-dimensions*
238          for i from 1
239          collect (make-array d :displaced-to *default-array-target*
240                              :displaced-index-offset i))
241    
242         (list
243          #()
244          #*
245          #*00000
246          #*1010101010101101)
247    
248         ;; Integer arrays
249         (list
250          (make-array '(10) :element-type '(integer 0 (256))
251                      :initial-contents '(8 9 10 11 12 1 2 3 4 5))
252          (make-array '(10) :element-type '(integer -128 (128))
253                      :initial-contents '(8 9 -10 11 -12 1 -2 -3 4 5))
254          (make-array '(6) :element-type '(integer 0 (#.(ash 1 16)))
255                      :initial-contents '(5 9 100 1312 23432 87))
256          (make-array '(4) :element-type '(integer 0 (#.(ash 1 28)))
257                      :initial-contents '(100000 231213 8123712 19))
258          (make-array '(4) :element-type '(integer 0 (#.(ash 1 32)))
259                      :initial-contents '(#.(1- (ash 1 32)) 0 872312 10000000))
260          
261          (make-array nil :element-type '(integer 0 (256))
262                      :initial-element 14)
263          (make-array '(2 2) :element-type '(integer 0 (256))
264                      :initial-contents '((34 98)(14 119)))
265          )
266    
267         ;; Float arrays
268         (list
269          (make-array '(5) :element-type 'short-float
270                      :initial-contents '(1.0s0 2.0s0 3.0s0 4.0s0 5.0s0))
271          (make-array '(5) :element-type 'single-float
272                      :initial-contents '(1.0f0 2.0f0 3.0f0 4.0f0 5.0f0))
273          (make-array '(5) :element-type 'double-float
274                      :initial-contents '(1.0d0 2.0d0 3.0d0 4.0d0 5.0d0))
275          (make-array '(5) :element-type 'long-float
276                      :initial-contents '(1.0l0 2.0l0 3.0l0 4.0l0 5.0l0))
277          )
278            
279       ;; more kinds of arrays here later       ;; more kinds of arrays here later
280       ))       ))

Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4

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