Commit a85982bd authored by pfdietz's avatar pfdietz

Fixed some base-string != string problems

parent 08989f79
......@@ -32,14 +32,14 @@
(#\a #\b #\c))
(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))
(deftest loop.5.8
(let ((x "abcd")) (loop for e of-type character across x collect e))
(#\a #\b #\c #\d))
(deftest loop.5.10
(let ((x #*00010110))
(loop for e across x collect e))
......
......@@ -299,7 +299,9 @@
(loop
for args = (make-random-write-args)
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))
(with-output-to-string (s) (apply #'write obj :stream s ,@write-args args)))
for s2 = (let ((*package* package))
......@@ -326,7 +328,9 @@
(loop
for args = (make-random-write-args)
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))
(with-output-to-string (s) (apply #'write obj :stream s ,@write-args args)))
for s2 = (let ((*package* package))
......
......@@ -72,6 +72,7 @@
(declaim (special +standard-chars+ *cl-symbols-vector*))
#|
(defun make-random-string (n)
(make-array n
:initial-contents
......@@ -79,6 +80,39 @@
(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)
(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 ()
(rcase
......
......@@ -5,6 +5,8 @@
(in-package :cl-test)
(eval-when (load eval compile) (compile-and-load "random-aux.lsp"))
(defun my-string-compare (string1 string2 comparison
&key (start1 0) end1 (start2 0) end2 case
&aux
......@@ -138,28 +140,6 @@
(or (eql x y)
(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)
(let ((len (length s)))
(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