Skip to content
GitLab
Explore
Sign in
Register
Primary navigation
Search or go to…
Project
ansi-test
Manage
Activity
Members
Labels
Plan
Issues
Issue boards
Milestones
Wiki
Code
Merge requests
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Snippets
Deploy
Releases
Container registry
Model registry
Monitor
Incidents
Service Desk
Analyze
Value stream analytics
Contributor analytics
Repository analytics
Model experiments
Help
Help
Support
GitLab documentation
Compare GitLab plans
Community forum
Contribute to GitLab
Provide feedback
Terms and privacy
Keyboard shortcuts
?
Snippets
Groups
Projects
Show more breadcrumbs
Michał Herda
ansi-test
Commits
dffc9188
Commit
dffc9188
authored
20 years ago
by
pfdietz
Browse files
Options
Downloads
Patches
Plain Diff
More symbol reading tests
parent
3133c1f7
No related branches found
No related tags found
No related merge requests found
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
ansi-tests/reader-test.lsp
+222
-64
222 additions, 64 deletions
ansi-tests/reader-test.lsp
with
222 additions
and
64 deletions
ansi-tests/reader-test.lsp
+
222
−
64
View file @
dffc9188
...
...
@@ -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)
This diff is collapsed.
Click to expand it.
Preview
0%
Loading
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Save comment
Cancel
Please
register
or
sign in
to comment