From d9824270f1ae52abf0818e9bc3324632040d8cc6 Mon Sep 17 00:00:00 2001
From: pfdietz <pfdietz@localhost>
Date: Tue, 4 Jan 2005 15:18:31 +0000
Subject: [PATCH] More syntax tests

---
 ansi-tests/ansi-aux.lsp       |   8 +
 ansi-tests/copy-readtable.lsp |   9 +
 ansi-tests/syntax.lsp         | 496 +++++++++++++++++++++++++++++++++-
 3 files changed, 506 insertions(+), 7 deletions(-)

diff --git a/ansi-tests/ansi-aux.lsp b/ansi-tests/ansi-aux.lsp
index 20aba288..d848986a 100644
--- a/ansi-tests/ansi-aux.lsp
+++ b/ansi-tests/ansi-aux.lsp
@@ -1056,3 +1056,11 @@ the condition to go uncaught if it cannot be classified."
   (handler-case
    (progn (string x) t)
    (error nil)))
+
+
+;;; Define a test using standard io syntax
+
+(defmacro def-syntax-test (name form &body expected-results)
+  `(deftest ,name
+     (with-standard-io-syntax (let ((*package* (find-package :cl-test))) ,form))
+     ,@expected-results))
diff --git a/ansi-tests/copy-readtable.lsp b/ansi-tests/copy-readtable.lsp
index 4c8329b3..26d61ab3 100644
--- a/ansi-tests/copy-readtable.lsp
+++ b/ansi-tests/copy-readtable.lsp
@@ -33,6 +33,15 @@
     (notnot (eql rt rt2)))
   t)
 
+;;; NIL as a readtable designator indicating the standard readtable
+(deftest copy-readtable.7
+  (let ((rt (copy-readtable nil)))
+    (values
+     (notnot rt)
+     (notnot (readtablep rt))
+     (not (eql rt *readtable*))))
+  t t t)
+
 ;;; Error tests
 
 (deftest copy-readtable.error.1
diff --git a/ansi-tests/syntax.lsp b/ansi-tests/syntax.lsp
index bcb40009..37bd9580 100644
--- a/ansi-tests/syntax.lsp
+++ b/ansi-tests/syntax.lsp
@@ -5,11 +5,6 @@
 
 (in-package :cl-test)
 
-(defmacro def-syntax-test (name form &rest expected-results)
-  `(deftest ,name
-     (with-standard-io-syntax ,form)
-     ,@expected-results))
-
 ;;; Test that 
 (def-syntax-test syntax.whitespace.1
   ;; Check that various standard or semistandard characters are whitespace[2]
@@ -165,7 +160,11 @@
 		(list (list name c s val)))))))
   nil)
 
-#|
+;;;
+;;; CLtS appears to be inconsistent on the next test.
+;;; Compare the definition of 'invalid' with the specification
+;;; of the token reading algorithm.
+;;;
 (def-syntax-test syntax.escape.whitespace.2
   (let ((names '("Tab" "Newline" "Linefeed" "Space" "Return" "Page")))
     (loop for name in names
@@ -177,8 +176,8 @@
 	      (unless (eql val (intern (string c)))
 		(list (list name c s val)))))))
   nil)
-|#
 
+#|
 (def-syntax-test syntax.multiple-escape.invalid.backspace
   (let ((c (name-char "Backspace")))
     (or (not c)
@@ -192,3 +191,486 @@
 	(let ((s (concatenate 'string "|" (string c) "|")))
 	  (eval `(signals-error (read-from-string ',s) reader-error)))))
   t)
+|#
+
+
+;;; Tests of #\
+
+(def-syntax-test syntax.sharp-backslash.1
+  (loop for c across +standard-chars+
+	for s = (concatenate 'string "#\\" (string c))
+	for c2 = (read-from-string s)
+	unless (eql c c2)
+	collect (list c s c2))
+  nil)
+
+(def-syntax-test syntax.sharp-backslash.2
+  (let ((count 0))
+    (loop for i below (min 65536 char-code-limit)
+	  for c = (code-char i)
+	  for s = (and c (concatenate 'string "#\\" (string c)))
+	  for c2 = (and c (read-from-string s))
+	  unless (eql c c2)
+	  collect (progn (when (> (incf count) 100) (loop-finish))
+			 (list c s c2))))
+  nil)
+
+(def-syntax-test syntax.sharp-backslash.3
+  (loop for i = (random (min (ash 1 24) char-code-limit))
+	for c = (code-char i)
+	for s = (and c (concatenate 'string "#\\" (string c)))
+	for c2 = (and c (read-from-string s))
+	repeat 1000
+	unless (eql c c2)
+	collect (list i c s c2))
+  nil)
+
+(def-syntax-test syntax.sharp-backslash.4
+  (flet ((%f (s) (read-from-string (concatenate 'string "#\\" s))))
+    (loop for s in '("SPACE" "NEWLINE" "TAB" "RUBOUT" "BACKSPACE" "PAGE" "LINEFEED" "RETURN")
+	  for c = (name-char s)
+	  unless (or (null c)
+		     (and (eql (%f s) c)
+			  (eql (%f (string-downcase s)) c)
+			  (eql (%f (string-capitalize s)) c)))
+	  collect (list s c)))
+  nil)
+
+(def-syntax-test syntax.sharp-backslash.5
+  (flet ((%f (s) (read-from-string (concatenate 'string "#\\" s))))
+    (loop for c across +standard-chars+
+	  for name = (char-name c)
+	  unless (or (null name)
+		     (and (eql (%f name) c)
+			  (eql (%f (string-downcase name)) c)
+			  (eql (%f (string-upcase name)) c)
+			  (eql (%f (string-capitalize name)) c)))
+	  collect (list c name)))
+  nil)
+
+(def-syntax-test syntax.sharp-backslash.6
+  (flet ((%f (s) (read-from-string (concatenate 'string "#\\" s))))
+    (loop for i below (min 65536 char-code-limit)
+	  for c = (code-char i)
+	  for name = (and c (char-name c))
+	  unless (or (null name)
+		     (and (eql (%f name) c)
+			  (eql (%f (string-downcase name)) c)
+			  (eql (%f (string-upcase name)) c)
+			  (eql (%f (string-capitalize name)) c)))
+	  collect (list i c name)))
+  nil)
+
+(def-syntax-test syntax.sharp-backslash.7
+  (flet ((%f (s) (read-from-string (concatenate 'string "#\\" s))))
+    (loop for i = (random (min (ash 1 24) char-code-limit))
+	  for c = (code-char i)
+	  for name = (and c (char-name c))
+	  repeat 1000
+	  unless (or (null name)
+		     (and (eql (%f name) c)
+			  (eql (%f (string-downcase name)) c)
+			  (eql (%f (string-upcase name)) c)
+			  (eql (%f (string-capitalize name)) c)))
+	  collect (list i c name)))
+  nil)
+
+
+;;; Tests of #'
+
+(def-syntax-test syntax.sharp-quote.1
+  (read-from-string "#'X")
+  (function |X|) 3)
+
+(def-syntax-test syntax.sharp-quote.2
+  (read-from-string "#':X")
+  (function :|X|) 4)
+
+(def-syntax-test syntax.sharp-quote.3
+  (read-from-string "#'17")
+  (function 17) 4)
+
+(def-syntax-test syntax.sharp-quote.error.1
+  (signals-error (read-from-string "#'") end-of-file)
+  t)
+
+(def-syntax-test syntax.sharp-quote.error.2
+  (signals-error (read-from-string "(#'" nil nil) end-of-file)
+  t)
+
+;;; Tess of #(...)
+
+(defmacro def-syntax-vector-test (name form &body expected-elements)
+  `(def-syntax-test ,name
+     (let ((v (read-from-string ,form)))
+       (assert (simple-vector-p v))
+       v)
+     ,(apply #'vector expected-elements)))
+
+(def-syntax-vector-test syntax.sharp-left-paren.1
+  "#()")
+
+(def-syntax-vector-test syntax.sharp-left-paren.2
+  "#0()")
+
+(def-syntax-vector-test syntax.sharp-left-paren.3
+  "#(a)" a)
+
+(def-syntax-vector-test syntax.sharp-left-paren.4
+  "#(a b c)" a b c)
+
+(def-syntax-vector-test syntax.sharp-left-paren.5
+  "#2(a)" a a)
+
+(def-syntax-vector-test syntax.sharp-left-paren.6
+  "#5(a b)" a b b b b)
+
+(def-syntax-vector-test syntax.sharp-left-paren.7
+  "#5(a b c d e)" a b c d e)
+
+(def-syntax-vector-test syntax.sharp-left-paren.8
+  "#9(a b c d e)" a b c d e e e e e)
+
+(def-syntax-test syntax.sharp-left-paren.9
+  (let ((*read-base* 2))
+    (read-from-string "#10(a)"))
+  #(a a a a a a a a a a)
+  6)
+
+(def-syntax-test syntax.sharp-left-paren.error.1
+  (signals-error (read-from-string "#(") end-of-file)
+  t)
+
+(def-syntax-test syntax.sharp-left-paren.error.2
+  (signals-error (read-from-string "(#(" nil nil) end-of-file)
+  t)
+
+;;; Tests of #*
+
+(defmacro def-syntax-bit-vector-test (name form &body expected-elements)
+  `(def-syntax-test ,name
+     (let ((v (read-from-string ,form)))
+       (assert (simple-bit-vector-p v))
+       v)
+     ,(make-array (length expected-elements) :element-type 'bit :initial-contents expected-elements)))
+
+(def-syntax-bit-vector-test syntax.sharp-asterisk.1
+  "#*")
+
+(def-syntax-bit-vector-test syntax.sharp-asterisk.2
+  "#0*")
+
+(def-syntax-bit-vector-test syntax.sharp-asterisk.3
+  "#1*0" 0)
+
+(def-syntax-bit-vector-test syntax.sharp-asterisk.4
+  "#1*1" 1)
+
+(def-syntax-bit-vector-test syntax.sharp-asterisk.5
+  "#2*1" 1 1)
+
+(def-syntax-bit-vector-test syntax.sharp-asterisk.5
+  "#2*0" 0 0)
+
+(def-syntax-bit-vector-test syntax.sharp-asterisk.6
+  "#5*010" 0 1 0 0 0)
+
+(def-syntax-bit-vector-test syntax.sharp-asterisk.7
+  "#7*0101" 0 1 0 1 1 1 1)
+
+(def-syntax-bit-vector-test syntax.sharp-asterisk.8
+  "#10*01010" 0 1 0 1 0 0 0 0 0 0)
+
+(def-syntax-test syntax.sharp-asterisk.9
+  (let ((*read-base* 3))
+    (read-from-string "#10*01"))
+  #*0111111111
+  6)
+
+(def-syntax-test syntax.sharp-asterisk.10
+  (let ((*read-suppress* t))
+    (values (read-from-string "#1* ")))
+  nil)
+
+(def-syntax-test syntax.sharp-asterisk.11
+  (let ((*read-suppress* t))
+    (values (read-from-string "#1*00")))
+  nil)
+
+(def-syntax-test syntax.sharp-asterisk.12
+  (let ((*read-suppress* t))
+    (values (read-from-string "#*012")))
+  nil)
+
+(def-syntax-test syntax.sharp-asterisk.error.1
+  (signals-error (read-from-string "#1* X") reader-error)
+  t)
+
+(def-syntax-test syntax.sharp-asterisk.error.2
+  (signals-error (read-from-string "#2*011") reader-error)
+  t)
+
+(def-syntax-test syntax.sharp-asterisk.error.3
+  (signals-error (read-from-string "#*012") reader-error)
+  t)
+
+;;; Tests of #: ...
+
+(defmacro def-syntax-unintern-test (name string)
+  `(deftest ,name
+     (let ((s (read-from-string ,(concatenate 'string "#:" string))))
+       (values
+	(symbol-package s)
+	(symbol-name s)))
+     nil ,(string-upcase string)))
+
+(def-syntax-unintern-test syntax.sharp-colon.1 "")
+(def-syntax-unintern-test syntax.sharp-colon.2 "#")
+(def-syntax-unintern-test syntax.sharp-colon.3 "a")
+(def-syntax-unintern-test syntax.sharp-colon.4 "A")
+(def-syntax-unintern-test syntax.sharp-colon.5 "NIL")
+(def-syntax-unintern-test syntax.sharp-colon.6 "T")
+(def-syntax-unintern-test syntax.sharp-colon.7 ".")
+
+
+;;; Tests of #.
+
+(def-syntax-test syntax.sharp-dot.1
+  (read-from-string "#.(+ 1 2)")
+  3 9)
+
+(def-syntax-test syntax.sharp-dot.2
+  (read-from-string "#.'X")
+  X 4)
+
+(def-syntax-test syntax.sharp-dot.error.1
+  (signals-error (read-from-string "#.") end-of-file)
+  t)
+
+(def-syntax-test syntax.sharp-dot.error.2
+  (signals-error (read-from-string "(#." nil nil) end-of-file)
+  t)
+
+(def-syntax-test syntax.sharp-dot.error.3
+  (signals-error (let ((*read-eval* nil)) (read-from-string "#.1")) reader-error)
+  t)
+
+;;; Tests of #B
+
+(def-syntax-test syntax.sharp-b.1
+  (read-from-string "#b0")
+  0 3)
+
+(def-syntax-test syntax.sharp-b.2
+  (read-from-string "#B1")
+  1 3)
+
+(def-syntax-test syntax.sharp-b.3
+  (read-from-string "#b101101")
+  45 8)
+
+(def-syntax-test syntax.sharp-b.4
+  (read-from-string "#B101101")
+  45 8)
+
+(def-syntax-test syntax.sharp-b.5
+  (read-from-string "#b010001/100")
+  17/4 12)
+
+(def-syntax-test syntax.sharp-b.6
+  (read-from-string "#b-10011")
+  -19 8)
+
+(def-syntax-test syntax.sharp-b.7
+  (read-from-string "#B-1/10")
+  -1/2 7)
+
+(def-syntax-test syntax.sharp-b.8
+  (read-from-string "#B-0/10")
+  0 7)
+
+(def-syntax-test syntax.sharp-b.8
+  (read-from-string "#b0/111")
+  0 7)
+
+(def-syntax-test syntax.sharp-b.9
+  (let ((*read-eval* nil))
+    (read-from-string "#b-10/11"))
+  -2/3 8)
+
+;;; Tests of #O
+
+(def-syntax-test syntax.sharp-o.1
+  (read-from-string "#o0")
+  0 3)
+
+(def-syntax-test syntax.sharp-o.2
+  (read-from-string "#O7")
+  7 3)
+
+(def-syntax-test syntax.sharp-o.3
+  (read-from-string "#o10")
+  8 4)
+
+(def-syntax-test syntax.sharp-o.4
+  (read-from-string "#O011")
+  9 5)
+
+(def-syntax-test syntax.sharp-o.5
+  (read-from-string "#o-0")
+  0 4)
+
+(def-syntax-test syntax.sharp-o.6
+  (read-from-string "#O-1")
+  -1 4)
+
+(def-syntax-test syntax.sharp-o.7
+  (read-from-string "#O11/10")
+  9/8 7)
+
+(def-syntax-test syntax.sharp-o.8
+  (read-from-string "#o-1/10")
+  -1/8 7)
+
+(def-syntax-test syntax.sharp-o.9
+  (read-from-string "#O0/10")
+  0 6)
+
+(def-syntax-test syntax.sharp-o.10
+  (let ((*read-eval* nil))
+    (read-from-string "#o-10/11"))
+  -8/9 8)
+
+;;; Tests of #X
+
+(def-syntax-test syntax.sharp-x.1
+  (read-from-string "#x0")
+  0 3)
+
+(def-syntax-test syntax.sharp-x.2
+  (read-from-string "#X1")
+  1 3)
+
+(def-syntax-test syntax.sharp-x.3
+  (read-from-string "#xa")
+  10 3)
+
+(def-syntax-test syntax.sharp-x.4
+  (read-from-string "#Xb")
+  11 3)
+
+(def-syntax-test syntax.sharp-x.5
+  (read-from-string "#XC")
+  12 3)
+
+(def-syntax-test syntax.sharp-x.6
+  (read-from-string "#xD")
+  13 3)
+
+(def-syntax-test syntax.sharp-x.7
+  (read-from-string "#xe")
+  14 3)
+
+(def-syntax-test syntax.sharp-x.8
+  (read-from-string "#Xf")
+  15 3)
+
+(def-syntax-test syntax.sharp-x.9
+  (read-from-string "#x10")
+  16 4)
+
+(def-syntax-test syntax.sharp-x.10
+  (read-from-string "#X1ab")
+  427 5)
+
+(def-syntax-test syntax.sharp-x.11
+  (read-from-string "#x-1")
+  -1 4)
+
+(def-syntax-test syntax.sharp-x.12
+  (read-from-string "#X-0")
+  0 4)
+
+(def-syntax-test syntax.sharp-x.13
+  (read-from-string "#xa/B")
+  10/11 5)
+
+(def-syntax-test syntax.sharp-x.14
+  (read-from-string "#X-1/1c")
+  -1/28 7)
+
+(def-syntax-test syntax.sharp-x.15
+  (let ((*read-eval* nil))
+    (read-from-string "#x-10/11"))
+  -16/17 8)
+
+;;; Tests of #nR
+
+(def-syntax-test syntax.sharp-r.1
+  (loop for i = (random (ash 1 (+ 2 (random 32))))
+	for base = (+ 2 (random 35))
+	for s = (let ((*print-base* base)) (write-to-string i))
+	for c = (random-from-seq "rR")
+	for s2 = (format nil "#~d~c~a" base c s)
+	for s3 = (rcase (1 (string-upcase s2))
+			(1 (string-downcase s2))
+			(1 (string-capitalize s2))
+			(1 s2))
+	for base2 = (+ 2 (random 35))
+	for vals = (let ((*read-base* base2))
+		     (multiple-value-list
+		      (read-from-string s3)))
+	repeat 1000
+	unless (equal vals (list i (length s3) ))
+	collect (list i base s c s2 s3 base2 vals))
+  nil)
+
+(def-syntax-test syntax.sharp-r.2
+  (read-from-string "#2r0")
+  0 4)
+
+(def-syntax-test syntax.sharp-r.3
+  (read-from-string "#36r0")
+  0 5)
+
+(def-syntax-test syntax.sharp-r.4
+  (read-from-string "#29R-0")
+  0 6)
+
+(def-syntax-test syntax.sharp-r.5
+  (read-from-string "#23r-1")
+  -1 6)
+
+(def-syntax-test syntax.sharp-r.6
+  (read-from-string "#17r11")
+  18 6)
+
+(def-syntax-test syntax.sharp-t.7
+  (read-from-string "#3r10/11")
+  3/4 8)
+
+(def-syntax-test syntax.sharp-t.8
+  (read-from-string "#5R-10/11")
+  -5/6 9)
+
+;;; Tests of #c
+
+(def-syntax-test syntax.sharp-c.1
+  (read-from-string "#c(1 1)")
+  #.(complex 1 1) 7)
+
+(def-syntax-test syntax.sharp-c.2
+  (read-from-string "#C(1 0)")
+  1 7)
+
+(def-syntax-test syntax.sharp-c.3
+  (read-from-string "#c(0 1)")
+  #.(complex 0 1) 7)
+
+(def-syntax-test syntax.sharp-c.4
+  (read-from-string "#c(-1/2 1)")
+  #.(complex -1/2 1) 10)
+
+(def-syntax-test syntax.sharp-c.5
+  (read-from-string "#c (1 1)")
+  #.(complex 1 1) 8)
-- 
GitLab