/[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.73 by pfdietz, Thu Jul 3 12:14:04 2003 UTC revision 1.74 by pfdietz, Sat Jul 12 13:46:01 2003 UTC
# Line 31  Line 31 
31             (not (first results))             (not (first results))
32             (rest results))))             (rest results))))
33    
34    (declaim (ftype (function (t) function) to-function))
35    
36    (defun to-function (fn)
37      (etypecase fn
38        (function fn)
39        (symbol (symbol-function fn))
40        ((cons (eql setf) symbol) (fdefinition fn))))    
41    
42  ;;; Macro to check that a function is returning a specified number of values  ;;; Macro to check that a function is returning a specified number of values
43  ;;; (defaults to 1)  ;;; (defaults to 1)
# Line 107  Results: ~A~%" expected-number form n re Line 114  Results: ~A~%" expected-number form n re
114         (typep a2 'array)         (typep a2 'array)
115         (= (array-rank a1) (array-rank a2))         (= (array-rank a1) (array-rank a2))
116         (if (= (array-rank a1) 0)         (if (= (array-rank a1) 0)
117             (equal (aref a1) (aref a2))             (equal (rt::my-aref a1) (rt::my-aref a2))
118           (let ((ad (array-dimensions a1)))           (let ((ad (array-dimensions a1)))
119             (and (equal ad (array-dimensions a2))             (and (equal ad (array-dimensions a2))
120                  (locally                  (locally
# Line 116  Results: ~A~%" expected-number form n re Line 123  Results: ~A~%" expected-number form n re
123                       (let ((as (first ad)))                       (let ((as (first ad)))
124                         (loop                         (loop
125                          for i from 0 below as                          for i from 0 below as
126                          always (equal (aref a1 i) (aref a2 i))))                          always (equal (rt::my-aref a1 i) (rt::my-aref a2 i))))
127                     (let ((as (array-total-size a1)))                     (let ((as (array-total-size a1)))
128                       (and (= as (array-total-size a2))                       (and (= as (array-total-size a2))
129                            (loop                            (loop
130                             for i from 0 below as                             for i from 0 below as
131                             always (equal (row-major-aref a1 i)                             always (equal (rt::my-row-major-aref a1 i)
132                                           (row-major-aref a2 i))))))))))))                                           (rt::my-row-major-aref a2 i))))))))))))
133    
134  ;;; *universe* is defined elsewhere -- it is a list of various  ;;; *universe* is defined elsewhere -- it is a list of various
135  ;;; lisp objects used when stimulating things in various tests.  ;;; lisp objects used when stimulating things in various tests.
# Line 1281  the condition to go uncaught if it canno Line 1288  the condition to go uncaught if it canno
1288    (classify-error* (elt x n)))    (classify-error* (elt x n)))
1289    
1290  (defmacro defstruct* (&body args)  (defmacro defstruct* (&body args)
1291    `(eval-when #+gcl (load eval compile)    `(eval-when (:load-toplevel :compile-toplevel :execute)
               #-gcl (:load-toplevel :compile-toplevel :execute)  
1292       (handler-case (eval '(defstruct ,@args))       (handler-case (eval '(defstruct ,@args))
1293                        (serious-condition () nil))))                        (serious-condition () nil))))
1294    

Legend:
Removed from v.1.73  
changed lines
  Added in v.1.74

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