/[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.5 by pfdietz, Thu Oct 17 13:16:55 2002 UTC revision 1.6 by pfdietz, Fri Oct 18 02:36:06 2002 UTC
# Line 9  Line 9 
9  (declaim (optimize (safety 3)))  (declaim (optimize (safety 3)))
10    
11  (defun eqt (x y)  (defun eqt (x y)
12    "Function like EQ, but guaranteed to return T for true."    "Like EQ, but guaranteed to return T for true."
13    (if (eq x y) t nil))    (if (eq x y) t nil))
14    
15    (defun eqlt (x y)
16      "Like EQL, but guaranteed to return T for true."
17      (if (eql x y) t nil))
18    
19    (defun equalt (x y)
20      "Like EQUAL, but guaranteed to return T for true."
21      (if (equal x y) t nil))
22    
23    (defun equalpt (x y)
24      "Like EQUALP, but guaranteed to return T for true."
25      (if (equalp x y) t nil))
26    
27    (defun =t (x &rest args)
28      "Like =, but guaranteed to return T for true."
29      (if (apply #'= x args) t nil))
30    
31  (defun notnot (x) (not (not x)))  (defun notnot (x) (not (not x)))
32    
33  (defun make-int-list (n)  (defun make-int-list (n)
34    (loop for i from 0 to (1- n) collect i))    (loop for i from 0 below n collect i))
35    
36  (defun make-int-array (n &optional (fn #'make-array))  (defun make-int-array (n &optional (fn #'make-array))
37    (let ((a (funcall fn n)))    (let ((a (funcall fn n)))
38      (loop      (loop for i from 0 below n do (setf (aref a i) i))
         for i from 0 to (1- n) do  
           (setf (aref a i) i))  
39      a))      a))
40    
41  (defun equal-array (a1 a2)  (defun equal-array (a1 a2)
# Line 33  Line 47 
47                (if (= (array-rank a1) 1)                (if (= (array-rank a1) 1)
48                    (let ((as (first ad)))                    (let ((as (first ad)))
49                      (loop                      (loop
50                       for i from 0 to (1- as)                       for i from 0 below as
51                       always (equal (aref a1 i) (aref a2 i))))                       always (equal (aref a1 i) (aref a2 i))))
52                  (let ((as (array-total-size a1)))                  (let ((as (array-total-size a1)))
53                    (and (= as (array-total-size a2))                    (and (= as (array-total-size a2))
54                         (loop                         (loop
55                          for i from 0 to (1- as)                          for i from 0 below as
56                          always (equal (row-major-aref a1 i)                          always (equal (row-major-aref a1 i)
57                                        (row-major-aref a2 i))))))))))                                        (row-major-aref a2 i))))))))))
58    

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