Skip to content
Snippets Groups Projects
Commit dffc9188 authored by pfdietz's avatar pfdietz
Browse files

More symbol reading tests

parent 3133c1f7
No related branches found
No related tags found
No related merge requests found
......@@ -5,19 +5,19 @@
(in-package :cl-test)
(deftest read-symbol.1
(let ((*package* (find-package "CL-TEST")))
(ignore-errors (read-from-string "a")))
(compile-and-load "reader-aux.lsp")
(def-syntax-test read-symbol.1
(read-from-string "a")
a 1)
(deftest read-symbol.2
(let ((*package* (find-package "CL-TEST")))
(ignore-errors (read-from-string "|a|")))
(def-syntax-test read-symbol.2
(read-from-string "|a|")
|a| 3)
(deftest read-symbol.3
(def-syntax-test read-symbol.3
(multiple-value-bind (s n)
(let () (ignore-errors (read-from-string "#:abc")))
(read-from-string "#:abc")
(not
(and (symbolp s)
(eql n 5)
......@@ -25,9 +25,9 @@
(string-equal (symbol-name s) "abc"))))
nil)
(deftest read-symbol.4
(def-syntax-test read-symbol.4
(multiple-value-bind (s n)
(let () (ignore-errors (read-from-string "#:|abc|")))
(read-from-string "#:|abc|")
(not
(and (symbolp s)
(eql n 7)
......@@ -35,9 +35,9 @@
(string= (symbol-name s) "abc"))))
nil)
(deftest read-symbol.5
(def-syntax-test read-symbol.5
(multiple-value-bind (s n)
(let () (ignore-errors (read-from-string "#:||")))
(read-from-string "#:||")
(if (not (symbolp s))
s
(not (not
......@@ -46,10 +46,10 @@
(string= (symbol-name s) ""))))))
t)
(deftest read-symbol.6
(def-syntax-test read-symbol.6
(let ((str "cl-test::abcd0123"))
(multiple-value-bind (s n)
(ignore-errors (read-from-string str))
(read-from-string str)
(if (not (symbolp s))
s
(not (not
......@@ -59,9 +59,9 @@
"abcd0123")))))))
t)
(deftest read-symbol.7
(def-syntax-test read-symbol.7
(multiple-value-bind (s n)
(let () (ignore-errors (read-from-string ":ABCD")))
(read-from-string ":ABCD")
(if (not (symbolp s))
s
(not (not
......@@ -71,58 +71,216 @@
"ABCD"))))))
t)
(defun read-symbol.9-body (natoms maxlen)
(let* ((chars (concatenate 'string
"abcdefghijklmnopqrstuvwxyz"
"ABCDEFGHIJKLMNOPQRSTUVWXYZ"
"0123456789"
"<,>.?/\"':;[{]}~`!@#$%^&*()_-+= \\|"))
(nchars (length chars)))
(loop
for i from 1 to natoms
count
(let* ((len (random (1+ maxlen)))
(actual-len 0)
(s (make-string (+ 2 (* 2 len))))
(s2 (make-string len)))
(loop for j from 0 to (1- len) do
(let ((c (elt chars (random (max 1 (1- nchars))))))
(when (member c '(#\| #\\))
(setf (elt s actual-len) #\\)
(incf actual-len))
(setf (elt s actual-len) c)
(setf (elt s2 j) c)
(incf actual-len)))
(let ((actual-string (subseq s 0 actual-len)))
(multiple-value-bind (sym nread)
(ignore-errors (read-from-string
(concatenate 'string
"#:|" actual-string "|")))
(unless (and (symbolp sym)
(eql nread (+ 4 actual-len))
(string-equal s2 (symbol-name sym)))
(let ((*print-readably* t))
(format t "Symbol read failed: ~S (~S) read as ~S~%"
actual-string s2 sym))
t)))))))
(deftest read-symbol.9
(read-symbol.9-body 1000 100)
(defun read-symbol.9-body (natoms maxlen &optional (chars +standard-chars+))
(loop
repeat natoms
count
(let* ((len (random (1+ maxlen)))
(actual-len 0)
(s (make-string (+ 2 (* 2 len))))
(s2 (make-string len)))
(loop for j from 0 to (1- len) do
(let ((c (random-from-seq chars)))
(when (member c '(#\| #\\))
(setf (elt s actual-len) #\\)
(incf actual-len))
(setf (elt s actual-len) c)
(setf (elt s2 j) c)
(incf actual-len)))
(let ((actual-string (subseq s 0 actual-len)))
(multiple-value-bind (sym nread)
(read-from-string
(concatenate 'string "#:|" actual-string "|"))
(unless (and (symbolp sym)
(eql nread (+ 4 actual-len))
(string-equal s2 (symbol-name sym)))
(let ((*print-readably* t))
(format t "Symbol read failed: ~S (~S) read as ~S~%"
actual-string s2 sym))
t))))))
(def-syntax-test read-symbol.9
(read-symbol.9-body 1000 100)
0)
(def-syntax-test read-symbol.9a
(let ((chars (coerce (loop for i below (min 256 char-code-limit)
for c = (code-char i)
when c collect c)
'string)))
(if (> (length chars) 0)
(read-symbol.9-body 1000 100)
0))
0)
(deftest read-symbol.10
(handler-case
(not (not
(equal (symbol-name
(read-from-string
(with-output-to-string (s)
(write (make-symbol ":")
:readably t
:stream s))))
":")))
(error (c) c))
(def-syntax-test read-symbol.9b
(let ((chars (coerce (loop for i below (min 65536 char-code-limit)
for c = (code-char i)
when c collect c)
'string)))
(if (> (length chars) 0)
(read-symbol.9-body 1000 100)
0))
0)
(def-syntax-test read-symbol.10
(equalt (symbol-name
(read-from-string
(with-output-to-string (s)
(write (make-symbol ":")
:readably t
:stream s))))
":")
t)
(def-syntax-test read-symbol.11
(loop for c across +standard-chars+
for str = (make-array 2 :element-type 'character :initial-contents (list #\\ c))
for sym = (read-from-string str)
unless (and (symbolp sym)
(eql sym (find-symbol (string c)))
(equal (symbol-name sym) (string c)))
collect (list c str sym))
nil)
(def-syntax-test read-symbol.12
(loop for c across +standard-chars+
for str = (make-array 2 :element-type 'base-char :initial-contents (list #\\ c))
for sym = (read-from-string str)
unless (and (symbolp sym)
(eql sym (find-symbol (string c)))
(equal (symbol-name sym) (string c)))
collect (list c str sym))
nil)
(def-syntax-test read-symbol.13
(loop for i below (min 65536 char-code-limit)
for c = (code-char i)
for str = (and c (make-array 2 :element-type 'character :initial-contents (list #\\ c)))
for sym = (and c (read-from-string str))
unless (or (not c)
(and (symbolp sym)
(eql sym (find-symbol (string c)))
(equal (symbol-name sym) (string c))))
collect (list c str sym))
nil)
(def-syntax-test read-symbol.14
(loop for i = (random (min (ash 1 24) char-code-limit))
for c = (code-char i)
for str = (and c (make-array 2 :element-type 'character :initial-contents (list #\\ c)))
for sym = (and c (read-from-string str))
repeat 1000
unless (or (not c)
(and (symbolp sym)
(eql sym (find-symbol (string c)))
(equal (symbol-name sym) (string c))))
collect (list c str sym))
nil)
(def-syntax-test read-symbol.15
(loop for c across "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ!@$%^&*_-+={}[]<>?/~"
for str = (string c)
for sym = (read-from-string str)
unless (eql sym (find-symbol (string (char-upcase c))))
collect (list c str sym))
nil)
(def-syntax-test read-symbol.16
(let ((*readtable* (copy-readtable)))
(setf (readtable-case *readtable*) :downcase)
(loop for c across "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ!@$%^&*_-+={}[]<>?/~"
for str = (string c)
for sym = (read-from-string str)
unless (eql sym (find-symbol (string (char-downcase c))))
collect (list c str sym)))
nil)
(def-syntax-test read-symbol.17
(let ((*readtable* (copy-readtable)))
(setf (readtable-case *readtable*) :preserve)
(loop for c across "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ!@$%^&*_-+={}[]<>?/~"
for str = (string c)
for sym = (read-from-string str)
unless (eql sym (find-symbol str))
collect (list c str sym)))
nil)
(def-syntax-test read-symbol.18
(let ((*readtable* (copy-readtable)))
(setf (readtable-case *readtable*) :invert)
(loop for c across "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ!@$%^&*_-+={}[]<>?/~"
for str = (string c)
for sym = (read-from-string str)
for c2 = (cond ((upper-case-p c) (char-downcase c))
((lower-case-p c) (char-upcase c))
(t c))
unless (eql sym (find-symbol (string c2)))
collect (list c c2 str sym)))
nil)
(def-syntax-test read-symbol.19
(read-from-string "123||")
|123| 5)
(def-syntax-test read-symbol.20
(read-from-string "123\\4")
|1234| 5)
(def-syntax-test read-symbol.21
(read-from-string "\\:1234")
|:1234| 6)
(def-syntax-test read-symbol.22
(read-from-string "||")
#.(intern "" (find-package "CL-TEST")) 2)
(def-syntax-test read-symbol.23
(loop for c across +standard-chars+
for s = (concatenate 'string (string c) ".")
for sym = (intern (string-upcase s))
when (alpha-char-p c)
nconc
(let ((sym2 (let ((*read-base* 36))
(read-from-string s))))
(if (eq sym sym2)
nil
(list c s sym sym2))))
nil)
(def-syntax-test read-symbol.24
(loop for c1 = (random-from-seq +alpha-chars+)
for c2 = (random-from-seq +alpha-chars+)
for d1 = (loop repeat (random 4) collect (random-from-seq +digit-chars+))
for d2 = (loop repeat (random 4) collect (random-from-seq +digit-chars+))
for s = (concatenate 'string d1 (list c1 c2) d2)
for sym = (intern (string-upcase s))
repeat 1000
nconc
(let ((sym2 (read-from-string s)))
(if (eq sym sym2)
nil
(list c1 c2 d1 d2 s sym sym2))))
nil)
(def-syntax-test read-symbol.25
(let ((potential-chars "01234567890123456789+-esdlf_^/")
(*readtable* (copy-readtable)))
(setf (readtable-case *readtable*) :preserve)
(loop for d1 = (loop repeat (random 6)
collect (random-from-seq potential-chars))
for c = (random-from-seq potential-chars)
for d2 = (loop repeat (random 6)
collect (random-from-seq potential-chars))
for s1 = (concatenate 'string d1 (list c) d2)
for sym1 = (intern s1)
for s2 = (concatenate 'string d1 (list #\\ c) d2)
for sym2 = (read-from-string s2)
repeat 1000
unless (eql sym1 sym2)
collect (list d1 c d2 s1 sym1 s2 sym2)))
nil)
(deftest read-float.1
(eqlt -0.0 (- 0.0))
t)
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment