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

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

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

revision 1.3 by pfdietz, Thu Oct 17 13:16:56 2002 UTC revision 1.4 by pfdietz, Sun Jul 27 15:30:39 2003 UTC
# Line 55  Line 55 
55            i1            i1
56          nil)))          nil)))
57      (t      (t
58       (let ((c1 (char string1 i1))       (let ((c1 (my-aref string1 i1))
59             (c2 (char string2 i2)))             (c2 (my-aref string2 i2)))
60         (cond         (cond
61          ((funcall equal-fn c1 c2))          ((funcall equal-fn c1 c2))
62          (t ;; mismatch found -- what kind?          (t ;; mismatch found -- what kind?
# Line 138  Line 138 
138               (or (eql x y)               (or (eql x y)
139                   (and x y (eqt comparison '=))))))))                   (and x y (eqt comparison '=))))))))
140    
141    (defparameter *use-random-byte* t)
142    
143  (defun make-random-string (n)  (defun make-random-string (n)
144    (let ((s (random-case    (let ((s (random-case
145              (make-string n)              (make-string n)
# Line 153  Line 155 
155        (dotimes (i n)        (dotimes (i n)
156          (dotimes (i n)          (dotimes (i n)
157            (setf (char s i)            (setf (char s i)
158                  (or (code-char (random 256))                  (or (and *use-random-byte* (code-char (random 256)))
159                      (elt "abcdefghijklmnopqrstuvwyxzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"                      (elt "abcdefghijklmnopqrstuvwyxzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
160                           (random 62)))))))                           (random 62)))))))
161      s))      s))
# Line 161  Line 163 
163  (defun string-all-the-same (s)  (defun string-all-the-same (s)
164    (let ((len (length s)))    (let ((len (length s)))
165      (or (= len 0)      (or (= len 0)
166          (let ((c (char s 0)))          (let ((c (my-aref s 0)))
167            (loop for d across s always (eql c d))))))            (loop for i below len
168                    for d = (my-aref s i)
169                    always (eql c d))))))

Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4

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