From b2981971f22303814a9058291093a6b80da4741c Mon Sep 17 00:00:00 2001
From: pfdietz <pfdietz@localhost>
Date: Fri, 1 Jul 2005 12:34:36 +0000
Subject: [PATCH] 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.

---
 ansi-tests/random-aux.lsp      | 83 ++++++++++++++++++++++++++++++++-
 ansi-tests/random-int-form.lsp | 85 ++--------------------------------
 ansi-tests/random-types.lsp    | 26 ++++++++++-
 3 files changed, 110 insertions(+), 84 deletions(-)

diff --git a/ansi-tests/random-aux.lsp b/ansi-tests/random-aux.lsp
index 02364ced..8c0306b9 100644
--- a/ansi-tests/random-aux.lsp
+++ b/ansi-tests/random-aux.lsp
@@ -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)
 
diff --git a/ansi-tests/random-int-form.lsp b/ansi-tests/random-int-form.lsp
index 3a5740fc..8e7eedfb 100644
--- a/ansi-tests/random-int-form.lsp
+++ b/ansi-tests/random-int-form.lsp
@@ -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)
diff --git a/ansi-tests/random-types.lsp b/ansi-tests/random-types.lsp
index 7914802a..0e0263ec 100644
--- a/ansi-tests/random-types.lsp
+++ b/ansi-tests/random-types.lsp
@@ -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)))
-- 
GitLab