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) |
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 |
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. |
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 |
|
|