Commit dffc9188 authored by pfdietz's avatar pfdietz
Browse files

More symbol reading tests

parent 3133c1f7
......@@ -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)
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