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