Commit a85982bd authored by pfdietz's avatar pfdietz
Browse files

Fixed some base-string != string problems

parent 08989f79
...@@ -32,14 +32,14 @@ ...@@ -32,14 +32,14 @@
(#\a #\b #\c)) (#\a #\b #\c))
(deftest loop.5.7 (deftest loop.5.7
(let ((x "abcd")) (loop for e across (the base-string x) collect e)) (let ((x (make-array '(4) :initial-elements "abcd" :element-type 'base-char)))
(loop for e across (the base-string x) collect e))
(#\a #\b #\c #\d)) (#\a #\b #\c #\d))
(deftest loop.5.8 (deftest loop.5.8
(let ((x "abcd")) (loop for e of-type character across x collect e)) (let ((x "abcd")) (loop for e of-type character across x collect e))
(#\a #\b #\c #\d)) (#\a #\b #\c #\d))
(deftest loop.5.10 (deftest loop.5.10
(let ((x #*00010110)) (let ((x #*00010110))
(loop for e across x collect e)) (loop for e across x collect e))
......
...@@ -299,7 +299,9 @@ ...@@ -299,7 +299,9 @@
(loop (loop
for args = (make-random-write-args) for args = (make-random-write-args)
for package = (find-package (random-from-seq #("CL-TEST" "CL-USER" "KEYWORD"))) for package = (find-package (random-from-seq #("CL-TEST" "CL-USER" "KEYWORD")))
for obj = (random-thing (random 10)) for obj = (let ((*random-readable* t))
(declare (special *random-readable*))
(random-thing (random 10)))
for s1 = (let ((*package* package)) for s1 = (let ((*package* package))
(with-output-to-string (s) (apply #'write obj :stream s ,@write-args args))) (with-output-to-string (s) (apply #'write obj :stream s ,@write-args args)))
for s2 = (let ((*package* package)) for s2 = (let ((*package* package))
...@@ -326,7 +328,9 @@ ...@@ -326,7 +328,9 @@
(loop (loop
for args = (make-random-write-args) for args = (make-random-write-args)
for package = (find-package (random-from-seq #("CL-TEST" "CL-USER" "KEYWORD"))) for package = (find-package (random-from-seq #("CL-TEST" "CL-USER" "KEYWORD")))
for obj = (random-thing (random 10)) for obj = (let ((*random-readable* t))
(declare (special *random-readable*))
(random-thing (random 10)))
for s1 = (let ((*package* package)) for s1 = (let ((*package* package))
(with-output-to-string (s) (apply #'write obj :stream s ,@write-args args))) (with-output-to-string (s) (apply #'write obj :stream s ,@write-args args)))
for s2 = (let ((*package* package)) for s2 = (let ((*package* package))
......
...@@ -72,6 +72,7 @@ ...@@ -72,6 +72,7 @@
(declaim (special +standard-chars+ *cl-symbols-vector*)) (declaim (special +standard-chars+ *cl-symbols-vector*))
#|
(defun make-random-string (n) (defun make-random-string (n)
(make-array n (make-array n
:initial-contents :initial-contents
...@@ -79,6 +80,39 @@ ...@@ -79,6 +80,39 @@
(random-from-seq +standard-chars+)) (random-from-seq +standard-chars+))
:element-type (random-from-seq :element-type (random-from-seq
#(character standard-char base-char)))) #(character standard-char base-char))))
|#
(defparameter *use-random-byte* t)
(defparameter *random-readable* nil)
(defun make-random-string (n)
(let*
((use-random-byte nil)
(s (random-case
(progn
(setf use-random-byte *use-random-byte*)
(make-string n))
(progn
(setf use-random-byte *use-random-byte*)
(make-array n :element-type 'character
:initial-element #\a))
(make-array n :element-type (if *random-readable* 'character
'standard-char)
:initial-element #\a)
(make-array n :element-type (if *random-readable* 'character
'base-char)
:initial-element #\a))))
(if (coin)
(dotimes (i n)
(setf (char s i) (elt #(#\a #\b #\A #\B) (random 4))))
(dotimes (i n)
(dotimes (i n)
(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)))))))
s))
(defun random-leaf () (defun random-leaf ()
(rcase (rcase
......
...@@ -5,6 +5,8 @@ ...@@ -5,6 +5,8 @@
(in-package :cl-test) (in-package :cl-test)
(eval-when (load eval compile) (compile-and-load "random-aux.lsp"))
(defun my-string-compare (string1 string2 comparison (defun my-string-compare (string1 string2 comparison
&key (start1 0) end1 (start2 0) end2 case &key (start1 0) end1 (start2 0) end2 case
&aux &aux
...@@ -138,28 +140,6 @@ ...@@ -138,28 +140,6 @@
(or (eql x y) (or (eql x y)
(and x y (eqt comparison '=)))))))) (and x y (eqt comparison '=))))))))
(defparameter *use-random-byte* t)
(defun make-random-string (n)
(let ((s (random-case
(make-string n)
(make-array n :element-type 'character
:initial-element #\a)
(make-array n :element-type 'standard-char
:initial-element #\a)
(make-array n :element-type 'base-char
:initial-element #\a))))
(if (coin)
(dotimes (i n)
(setf (char s i) (elt #(#\a #\b #\A #\B) (random 4))))
(dotimes (i n)
(dotimes (i n)
(setf (char s i)
(or (and *use-random-byte* (code-char (random 256)))
(elt "abcdefghijklmnopqrstuvwyxzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
(random 62)))))))
s))
(defun string-all-the-same (s) (defun string-all-the-same (s)
(let ((len (length s))) (let ((len (length s)))
(or (= len 0) (or (= len 0)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment