/[gcl]/gcl/ansi-tests/random-aux.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/random-aux.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.7 by pfdietz, Sat Aug 7 23:02:26 2004 UTC revision 1.8 by pfdietz, Thu Aug 26 11:24:21 2004 UTC
# Line 72  Line 72 
72    
73  (declaim (special +standard-chars+ *cl-symbols-vector*))  (declaim (special +standard-chars+ *cl-symbols-vector*))
74    
75    #|
76  (defun make-random-string (n)  (defun make-random-string (n)
77    (make-array n    (make-array n
78                :initial-contents                :initial-contents
# Line 79  Line 80 
80                      (random-from-seq +standard-chars+))                      (random-from-seq +standard-chars+))
81                :element-type (random-from-seq                :element-type (random-from-seq
82                               #(character standard-char base-char))))                               #(character standard-char base-char))))
83    |#
84    
85    (defparameter *use-random-byte* t)
86    (defparameter *random-readable* nil)
87    
88    (defun make-random-string (n)
89      (let*
90          ((use-random-byte nil)
91           (s (random-case
92               (progn
93                 (setf use-random-byte *use-random-byte*)
94                 (make-string n))
95               (progn
96                 (setf use-random-byte *use-random-byte*)
97                 (make-array n :element-type  'character
98                             :initial-element #\a))
99               (make-array n :element-type (if *random-readable* 'character
100                                             'standard-char)
101                           :initial-element #\a)
102               (make-array n :element-type (if *random-readable* 'character
103                                             'base-char)
104                           :initial-element #\a))))
105        (if (coin)
106            (dotimes (i n)
107              (setf (char s i) (elt #(#\a #\b #\A #\B) (random 4))))
108          (dotimes (i n)
109            (dotimes (i n)
110              (setf (char s i)
111                    (or (and use-random-byte (or (code-char (random (min char-code-limit (ash 1 16))))
112                                                 (code-char (random 256))))
113                        (elt "abcdefghijklmnopqrstuvwyxzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
114                             (random 62)))))))
115        s))
116    
117  (defun random-leaf ()  (defun random-leaf ()
118    (rcase    (rcase

Legend:
Removed from v.1.7  
changed lines
  Added in v.1.8

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26