129 |
:rval rval)) |
:rval rval)) |
130 |
(unless (funcall test result rval) |
(unless (funcall test result rval) |
131 |
(return *random-type-prop-result*)))) |
(return *random-type-prop-result*)))) |
132 |
#+allegro (excl::gc t) |
;; #+allegro (excl::gc t) |
133 |
)))) |
)))) |
134 |
|
|
135 |
(defun make-random-arguments (types-or-funs) |
(defun make-random-arguments (types-or-funs) |
333 |
(find-package :cl-test)) |
(find-package :cl-test)) |
334 |
(do-random-type-prop-tests ,@args) |
(do-random-type-prop-tests ,@args) |
335 |
nil)) |
nil)) |
336 |
|
|
337 |
|
;;; Function used in constructing list types for some random type prop tests |
338 |
|
|
339 |
|
(defun make-list-type (length &optional (rest-type 'null) (element-type t)) |
340 |
|
(let ((result rest-type)) |
341 |
|
(loop repeat length |
342 |
|
do (setq result `(cons ,element-type ,result))) |
343 |
|
result)) |
344 |
|
|
345 |
|
(defun same-set-p (set1 set2 &rest args &key key test test-not) |
346 |
|
(declare (ignorable key test test-not)) |
347 |
|
(and (apply #'subsetp set1 set2 args) |
348 |
|
(apply #'subsetp set2 set2 args) |
349 |
|
t)) |
350 |
|
|
351 |
|
(defun index-type-for-dim (dim) |
352 |
|
"Returns a function that computes integer type for valid indices |
353 |
|
of an array dimension, or NIL if there are none." |
354 |
|
#'(lambda (array &rest other) |
355 |
|
(declare (ignore other)) |
356 |
|
(let ((d (array-dimension array dim))) |
357 |
|
(and (> d 0) `(integer 0 (,d)))))) |
358 |
|
|
359 |
|
(defun index-type-for-v1 (v1 &rest other) |
360 |
|
"Computes integer type for valid indices for the first of two vectors" |
361 |
|
(declare (ignore other)) |
362 |
|
(let ((d (length v1))) `(integer 0 ,d))) |
363 |
|
|
364 |
|
(defun index-type-for-v2 (v1 v2 &rest other) |
365 |
|
"Computes integer type for valid indices for the second of two vectors" |
366 |
|
(declare (ignore v1 other)) |
367 |
|
(let ((d (length v2))) `(integer 0 ,d))) |
368 |
|
|
369 |
|
(defun end-type-for-v1 (v1 v2 &rest other) |
370 |
|
(declare (ignore v2)) |
371 |
|
(let ((d (length v1)) |
372 |
|
(start1 (or (cadr (member :start1 other)) 0))) |
373 |
|
`(integer ,start1 ,d))) |
374 |
|
|
375 |
|
(defun end-type-for-v2 (v1 v2 &rest other) |
376 |
|
(declare (ignore v1)) |
377 |
|
(let ((d (length v2)) |
378 |
|
(start2 (or (cadr (member :start2 other)) 0))) |
379 |
|
`(integer ,start2 ,d))) |
380 |
|
|
381 |
|
|