From a5b00ef00814acdcb18c03e6f45a7bd293c34938 Mon Sep 17 00:00:00 2001
From: pfdietz <pfdietz@localhost>
Date: Sun, 27 Feb 2005 23:04:28 +0000
Subject: [PATCH] Various tweaks, including a workaround for the Lispworks bug
 in make-strings's :element-type default value

---
 ansi-tests/random-aux.lsp | 37 ++++++++++++++-----------------------
 1 file changed, 14 insertions(+), 23 deletions(-)

diff --git a/ansi-tests/random-aux.lsp b/ansi-tests/random-aux.lsp
index 91de092b..7740ff26 100644
--- a/ansi-tests/random-aux.lsp
+++ b/ansi-tests/random-aux.lsp
@@ -72,49 +72,40 @@
 
 (declaim (special +standard-chars+ *cl-symbols-vector*))
 
-#|
-(defun make-random-string (n)
-  (make-array n
-	      :initial-contents
-	      (loop repeat n collect
-		    (random-from-seq +standard-chars+))
-	      :element-type (random-from-seq
-			     #(character standard-char base-char))))
-|#
-
 (defparameter *use-random-byte* t)
 (defparameter *random-readable* nil)
 
-(defun make-random-string (n)
+(defun make-random-string (size-spec &key simple)
   (let*
-      ((use-random-byte nil)
+      ((size (if (eql size-spec '*) (random 30) size-spec))
+       (use-random-byte nil)
        (etype 'character)
        (s (random-case
 	   (progn
 	     (setf use-random-byte *use-random-byte*)
-	     (make-string n))
+	     (make-string size :element-type 'character))
 	   (progn
 	     (setf use-random-byte *use-random-byte*)
-	     (make-array n :element-type 'character
+	     (make-array size :element-type 'character
 			 :initial-element #\a))
-	   (make-array n :element-type (setf etype (if *random-readable* 'character 'standard-char))
-		       :adjustable (and (not *random-readable*) (rcase (3 nil) (1 t)))
-		       :fill-pointer (and (not *random-readable*) (rcase (3 nil) (1 (random (1+ n)))))
+	   (make-array size :element-type (setf etype (if *random-readable* 'character 'standard-char))
+		       :adjustable (and (not simple) (not *random-readable*) (rcase (3 nil) (1 t)))
+		       :fill-pointer (and (not simple) (not *random-readable*) (rcase (3 nil) (1 (random (1+ size)))))
 		       :initial-element #\a)
-	   (make-array n :element-type (setf etype (if *random-readable* 'character 'base-char))
-		       :adjustable (and (not *random-readable*) (rcase (3 nil) (1 t)))
-		       :fill-pointer (and (not *random-readable*) (rcase (3 nil) (1 (random (1+ n)))))
+	   (make-array size :element-type (setf etype (if *random-readable* 'character 'base-char))
+		       :adjustable (and (not simple) (not *random-readable*) (rcase (3 nil) (1 t)))
+		       :fill-pointer (and (not simple) (not *random-readable*) (rcase (3 nil) (1 (random (1+ size)))))
 		       :initial-element #\a))))
     (if (coin)
-	(dotimes (i n)
+	(dotimes (i size)
 	  (setf (char s i) (elt #(#\a #\b #\A #\B) (random 4))))
-      (dotimes (i n)
+      (dotimes (i size)
 	(setf (char s i)
 	      (or (and use-random-byte (or (code-char (random (min char-code-limit (ash 1 16))))
 					   (code-char (random 256))))
 		  (elt "abcdefghijklmnopqrstuvwyxzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
 		       (random 62))))))
-    (when (and (not *random-readable*) (coin 5))
+    (when (and (not simple) (not *random-readable*) (coin 5))
       (let* ((len (length s))
 	     (len2 (random (1+ len))))
 	(setf s (make-array len2
-- 
GitLab