From dffc9188c2733eff8aab62811e9c7a8549b431a8 Mon Sep 17 00:00:00 2001 From: pfdietz <pfdietz@localhost> Date: Mon, 17 Jan 2005 13:50:18 +0000 Subject: [PATCH] More symbol reading tests --- ansi-tests/reader-test.lsp | 286 ++++++++++++++++++++++++++++--------- 1 file changed, 222 insertions(+), 64 deletions(-) diff --git a/ansi-tests/reader-test.lsp b/ansi-tests/reader-test.lsp index 191eb8d6..ec6b70a4 100644 --- a/ansi-tests/reader-test.lsp +++ b/ansi-tests/reader-test.lsp @@ -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) -- GitLab