Skip to content
Snippets Groups Projects
Commit b2981971 authored by pfdietz's avatar pfdietz
Browse files

Make the random tester produce PROGV for ABCL. Move some functions over to...

Make the random tester produce PROGV for ABCL.  Move some functions over to random-aux.lsp (still need to refactor), and begin adding random real types to random-types.lsp.  Remove function types from random-types.
parent d186a78d
Branches
Tags
No related merge requests found
......@@ -5,6 +5,11 @@
(in-package :cl-test)
(declaim (special +standard-chars+ *cl-symbols-vector*))
(defvar *maximum-random-int-bits*
(max 36 (1+ (integer-length most-positive-fixnum))))
(defun random-from-seq (seq)
"Generate a random member of a sequence."
(let ((len (length seq)))
......@@ -36,6 +41,22 @@
collect `((< ,r ,cw) ,@(cdr case)))
(t ,@(cdar (last cases)))))))
(defun make-random-integer-range (&optional var)
"Generate a list (LO HI) of integers, LO <= HI. This is used
for generating integer types."
(declare (ignore var))
(rcase
(1 (flet ((%r () (let ((r (ash 1 (1+ (random *maximum-random-int-bits*)))))
(- (random r) (floor (/ r 2))))))
(let ((x (%r))
(y (%r)))
(list (min x y) (max x y)))))
(1 (let* ((b (ash 1 (1+ (random *maximum-random-int-bits*))))
(b2 (floor (/ b 2))))
(let ((x (- (random b) b2))
(y (- (random b) b2)))
(list (min x y) (max x y)))))))
(defun random-nonnegative-real ()
(if (coin 3)
(random-case
......@@ -53,6 +74,66 @@
(expt 2.0d0 (random 32))
(expt 2.0l0 (random 32))))))
(defun make-random-integer ()
(let ((r (ash 1 (1+ (random *maximum-random-int-bits*)))))
(rcase
(6 (- (random r) (floor (/ r 2))))
(1 (- r (random (min 10 r))))
(1 (+ (floor (/ r 2)) (random (min 10 r)))))))
(defun make-random-rational ()
(let* ((r (ash 1 (1+ (random *maximum-random-int-bits*))))
(n (random r)))
(assert (>= r 2))
(let ((d (loop for x = (random r) unless (zerop x) do (return x))))
(if (coin) (/ n d) (- (/ n d))))))
(defun make-random-nonnegative-rational ()
(let* ((r (ash 1 (1+ (random *maximum-random-int-bits*))))
(n (random r)))
(assert (>= r 2))
(let ((d (loop for x = (random r) unless (zerop x) do (return x))))
(/ n d))))
(defun make-random-positive-rational ()
(let* ((r (ash 1 (1+ (random *maximum-random-int-bits*))))
(n (1+ (random r))))
(assert (>= r 2))
(let ((d (loop for x = (random r) unless (zerop x) do (return x))))
(/ n d))))
(defun make-random-bounded-rational (upper-limit lower-inclusive upper-inclusive)
(assert (rationalp upper-limit))
(assert (not (minusp upper-limit)))
(cond
((= upper-limit 0) 0)
((<= upper-limit 1/1000000)
(/ (make-random-bounded-rational (* 1000000 upper-limit) lower-inclusive upper-inclusive)
1000000))
((>= upper-limit 1000000)
(* (random 1000000)
(make-random-bounded-rational (/ upper-limit 1000000) lower-inclusive upper-inclusive)))
(t
(assert (< 1/1000000 upper-limit 1000000))
(let ((x 0))
(loop do (setq x (* upper-limit (rational (random 1.0))))
while (or (and (not lower-inclusive) (zerop x))
(and (not upper-inclusive) (= x upper-limit)))
finally (return x))))))
(defun make-random-float ()
(rcase
(1 (random most-positive-short-float))
(1 (random most-positive-single-float))
(1 (random most-positive-double-float))
(1 (random most-positive-long-float))))
(defun make-random-symbol ()
(rcase
(3 (random-from-seq #(a b c d e f g h i j k l m n o p q r s t u v w x y z)))
(2 (random-from-seq *cl-symbols-vector*))
(1 (gensym))))
(defun random-real ()
(if (coin) (random-nonnegative-real)
(- (random-nonnegative-real))))
......@@ -70,8 +151,6 @@
(random-partition (1- n) (max 10 (1- n))))))
)))
(declaim (special +standard-chars+ *cl-symbols-vector*))
(defparameter *use-random-byte* t)
(defparameter *random-readable* nil)
......
......@@ -108,8 +108,6 @@
(defvar *random-int-form-catch-tags* nil)
(defvar *go-tags* nil)
(defvar *maximum-random-int-bits* 36)
(defvar *random-vals-list-bound* 10)
(defvar *max-compile-time* 0)
......@@ -241,22 +239,6 @@
(cons (car form) (mapcan #'fn-symbols-in-form* (cdr form)))
(mapcan #'fn-symbols-in-form* form))))
(defun make-random-integer-range (&optional var)
"Generate a list (LO HI) of integers, LO <= HI. This is used
for generating integer types."
(declare (ignore var))
(rcase
(1 (flet ((%r () (let ((r (ash 1 (1+ (random *maximum-random-int-bits*)))))
(- (random r) (floor (/ r 2))))))
(let ((x (%r))
(y (%r)))
(list (min x y) (max x y)))))
(1 (let* ((b (ash 1 (1+ (random *maximum-random-int-bits*))))
(b2 (floor (/ b 2))))
(let ((x (- (random b) b2))
(y (- (random b) b2)))
(list (min x y) (max x y)))))))
(defun fn-arg-name (fn-name arg-index)
(intern (concatenate 'string
(subseq (symbol-name fn-name) 1)
......@@ -266,65 +248,7 @@
(declaim (special *flet-names*))
(defparameter *flet-names* nil)
(defun make-random-integer ()
(let ((r (ash 1 (1+ (random *maximum-random-int-bits*)))))
(rcase
(6 (- (random r) (floor (/ r 2))))
(1 (- r (random (min 10 r))))
(1 (+ (floor (/ r 2)) (random (min 10 r)))))))
(defun make-random-rational ()
(let* ((r (ash 1 (1+ (random *maximum-random-int-bits*))))
(n (random r)))
(assert (>= r 2))
(let ((d (loop for x = (random r) unless (zerop x) do (return x))))
(if (coin) (/ n d) (- (/ n d))))))
(defun make-random-nonnegative-rational ()
(let* ((r (ash 1 (1+ (random *maximum-random-int-bits*))))
(n (random r)))
(assert (>= r 2))
(let ((d (loop for x = (random r) unless (zerop x) do (return x))))
(/ n d))))
(defun make-random-positive-rational ()
(let* ((r (ash 1 (1+ (random *maximum-random-int-bits*))))
(n (1+ (random r))))
(assert (>= r 2))
(let ((d (loop for x = (random r) unless (zerop x) do (return x))))
(/ n d))))
(defun make-random-bounded-rational (upper-limit lower-inclusive upper-inclusive)
(assert (rationalp upper-limit))
(assert (not (minusp upper-limit)))
(cond
((= upper-limit 0) 0)
((<= upper-limit 1/1000000)
(/ (make-random-bounded-rational (* 1000000 upper-limit) lower-inclusive upper-inclusive)
1000000))
((>= upper-limit 1000000)
(* (random 1000000)
(make-random-bounded-rational (/ upper-limit 1000000) lower-inclusive upper-inclusive)))
(t
(assert (< 1/1000000 upper-limit 1000000))
(let ((x 0))
(loop do (setq x (* upper-limit (rational (random 1.0))))
while (or (and (not lower-inclusive) (zerop x))
(and (not upper-inclusive) (= x upper-limit)))
finally (return x))))))
(defun make-random-float ()
(rcase
(1 (random most-positive-short-float))
(1 (random most-positive-single-float))
(1 (random most-positive-double-float))
(1 (random most-positive-long-float))))
(defun make-random-symbol ()
(rcase
(3 (random-from-seq #(a b c d e f g h i j k l m n o p q r s t u v w x y z)))
(2 (random-from-seq *cl-symbols-vector*))
(1 (gensym))))
(defun random-var-desc ()
(loop
......@@ -426,7 +350,6 @@
(2 `(isqrt (abs ,(make-random-integer-form (- size 2)))))
;; #-armedbear
(10 `(the integer ,(make-random-integer-form (1- size))))
(1 `(cl:handler-bind nil ,(make-random-integer-form (1- size))))
......@@ -549,7 +472,7 @@
(5 (make-random-tagbody-and-progn size))
;; conditionals
(30
(60
(let* ((cond-size (random (max 1 (floor size 2))))
(then-size (random (- size cond-size)))
(else-size (- size 1 cond-size then-size))
......@@ -575,7 +498,7 @@
(50 (make-random-integer-binding-form size))
;; progv
#-(or armedbear ecl)
#-(or ecl)
(4 (make-random-integer-progv-form size))
(4 `(let () ,(make-random-integer-form (1- size))))
......@@ -1068,7 +991,7 @@
(rcase
(1 (if (coin) t nil))
(3 `(not ,(make-random-pred-form (1- size))))
(6 (destructuring-bind (leftsize rightsize)
(12 (destructuring-bind (leftsize rightsize)
(random-partition (1- size) 2)
`(,(random-from-seq '(and or))
,(make-random-pred-form leftsize)
......
......@@ -19,6 +19,7 @@
(1 (random-from-seq #(integer unsigned-byte ratio rational real float
short-float single-float double-float
long-float complex symbol cons function)))
#|
(1
(let* ((len (random *maximum-random-int-bits*))
(r1 (ash 1 len))
......@@ -28,6 +29,9 @@
(lo (min x y))
(hi (max x y)))
`(integer ,lo ,hi)))
|#
(1 (make-random-real-type))
(1 (make-random-complex-type))
)
(rcase
(2 (let* ((op (random-from-seq #(cons cons and or)))
......@@ -36,9 +40,29 @@
(sizes (random-partition (1- size) nargs)))
`(,op ,@(mapcar #'make-random-type sizes))))
(1 `(not ,(make-random-type (1- size))))
(1 (make-random-function-type size))
; (1 (make-random-function-type size))
)))
(defun make-random-real-type ()
(rcase
(1 (random-from-seq '(integer unsigned-byte short-float single-float
double-float long-float rational real)))
(1 (destructuring-bind (lo hi)
(make-random-integer-range)
(rcase
(4 `(integer ,lo ,hi))
(1 `(integer ,lo))
(1 `(integer ,lo *))
(2 `(integer * ,hi)))))
(1 (let ((r1 (random-real))
(r2 (random-real)))
`(real ,(min r1 r2) ,(max r2 r2))))
;;; Add more cases here
))
(defun make-random-complex-type ()
`(complex ,(make-random-real-type)))
(defun make-random-function-type (size)
(let* ((sizes (random-partition (1- size) 2))
(types (mapcar #'make-random-type sizes)))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment