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

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

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

revision 1.2 by pfdietz, Sat Oct 12 18:44:42 2002 UTC revision 1.3 by pfdietz, Sun Oct 13 01:24:40 2002 UTC
# Line 11  Line 11 
11  (defun make-int-list (n)  (defun make-int-list (n)
12    (loop for i from 0 to (1- n) collect i))    (loop for i from 0 to (1- n) collect i))
13    
14    (defun make-int-array (n &optional (fn #'make-array))
15      (let ((a (funcall fn n)))
16        (loop
17            for i from 0 to (1- n) do
18              (setf (aref a i) i))
19        a))
20    
21    (defun equal-array (a1 a2)
22      (and (typep a1 'array)
23           (typep a2 'array)
24           (= (array-rank a1) (array-rank a2))
25           (let ((ad (array-dimensions a1)))
26             (and (equal ad (array-dimensions a2))
27                  (if (= (array-rank a1) 1)
28                      (let ((as (first ad)))
29                        (loop
30                         for i from 0 to (1- as)
31                         always (equal (aref a1 i) (aref a2 i))))
32                    (let ((as (array-total-size a1)))
33                      (and (= as (array-total-size a2))
34                           (loop
35                            for i from 0 to (1- as)
36                            always (equal (row-major-aref a1 i)
37                                          (row-major-aref a2 i))))))))))
38    
39  (declaim (special *universe*))  (declaim (special *universe*))
40    
41  (defun check-type-predicate (P TYPE)  (defun check-type-predicate (P TYPE)

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