diff --git a/ansi-tests/ansi-aux.lsp b/ansi-tests/ansi-aux.lsp index d848986ae32c2be905f5e19e15c9f4c3fae04849..20aba288aa6f3aad8d24f55def851ab870527f36 100644 --- a/ansi-tests/ansi-aux.lsp +++ b/ansi-tests/ansi-aux.lsp @@ -1056,11 +1056,3 @@ 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/load-reader.lsp b/ansi-tests/load-reader.lsp index 238c133621168dd5ee7e9999a04a5fd35c91cad1..ee17a31433e151496ad431a2b9aecd85ea1c9745 100644 --- a/ansi-tests/load-reader.lsp +++ b/ansi-tests/load-reader.lsp @@ -16,5 +16,7 @@ (load "readtablep.lsp") (load "get-macro-character.lsp") (load "set-macro-character.lsp") +(load "read-suppress.lsp") (load "syntax.lsp") +(load "syntax-tokens.lsp") diff --git a/ansi-tests/read-suppress.lsp b/ansi-tests/read-suppress.lsp new file mode 100644 index 0000000000000000000000000000000000000000..9644149d5dcbee2d114fade3ddc99f4a85b51f5b --- /dev/null +++ b/ansi-tests/read-suppress.lsp @@ -0,0 +1,252 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Jan 15 13:55:27 2005 +;;;; Contains: Tests of reading with *READ-SUPPRESS* bound to true + +(in-package :cl-test) + +(compile-and-load "reader-aux.lsp") + +(defmacro def-read-suppress-test (name string) + `(def-syntax-test ,name + (let ((*read-suppress* t)) + (read-from-string ,string)) + nil ,(length string))) + +(def-read-suppress-test read-suppress.1 "NONEXISTENT-PACKAGE::FOO") +(def-read-suppress-test read-suppress.2 ":") +(def-read-suppress-test read-suppress.3 "::") +(def-read-suppress-test read-suppress.4 ":::") +(def-read-suppress-test read-suppress.5 "123.45") +(def-read-suppress-test read-suppress.6 ".") +(def-read-suppress-test read-suppress.7 "..") +(def-read-suppress-test read-suppress.8 "...") +(def-read-suppress-test read-suppress.9 "(1 2)") +(def-read-suppress-test read-suppress.10 "(1 . 2)") +(def-read-suppress-test read-suppress.11 "(1 . 2 . 3)") +(def-read-suppress-test read-suppress.12 "(. 2)") + +(defparameter *non-macro-chars* + "1234567890abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ-=+_~!@$%^&*{}[]<>/?.") + +(declaim (type simple-base-string *non-macro-chars*)) + +(defmacro def-random-suppress-test (name &key + (chars '*non-macro-chars*) + (reps 10000) + (maxlen 8) + (count 10) + (prefix "") + (suffix "")) + `(def-syntax-test ,name + (let* ((chars ,chars) + (prefix ,prefix) + (suffix ,suffix) + (*read-suppress* t) + (count 0) + (maxlen ,maxlen) + (reps ,reps) + (maxcount ,count)) + (loop for n = (1+ (random maxlen)) + for s = (concatenate 'string + prefix + (loop repeat n + collect (random-from-seq chars)) + suffix) + for vals = (multiple-value-list + (handler-case (read-from-string s) + (reader-error (rc) rc))) + repeat 10000 + unless (equal vals (list nil (length s))) + collect (progn (when (> (incf count) maxcount) + (loop-finish)) + (list n s vals)))) + nil)) + + +(def-random-suppress-test read-suppress.13) +(def-random-suppress-test read-suppress.14 :prefix "(" :suffix ")") +(def-random-suppress-test read-suppress.15 :prefix "#(" :suffix ")") +(def-random-suppress-test read-suppress.16 :chars "0123456789.eEfFsSdDlL+-") + +(def-read-suppress-test read-suppress.sharp-slash.1 "#\\boguscharname") +(def-read-suppress-test read-suppress.sharp-slash.2 "#\\:x") +(def-read-suppress-test read-suppress.sharp-slash.3 "#\\::::") +(def-read-suppress-test read-suppress.sharp-slash.4 "#\\123") +(def-read-suppress-test read-suppress.sharp-slash.5 "#0\\ ") +(def-read-suppress-test read-suppress.sharp-slash.6 "#100000000\\Space") + +(def-read-suppress-test read-suppress.sharp-quote.1 "#'foo") +(def-read-suppress-test read-suppress.sharp-quote.2 "#'1") +(def-read-suppress-test read-suppress.sharp-quote.3 "#'(setf bar)") +(def-read-suppress-test read-suppress.sharp-quote.5 "#'.") +(def-read-suppress-test read-suppress.sharp-quote.6 "#'1.2.3") +(def-read-suppress-test read-suppress.sharp-quote.7 "#0'F") +(def-read-suppress-test read-suppress.sharp-quote.8 "#1000000'F") + +(def-read-suppress-test read-suppress.sharp-left-paren.1 "#()") +(def-read-suppress-test read-suppress.sharp-left-paren.2 "#(A)") +(def-read-suppress-test read-suppress.sharp-left-paren.3 "#(A B)") +(def-read-suppress-test read-suppress.sharp-left-paren.4 "#0()") +(def-read-suppress-test read-suppress.sharp-left-paren.5 "#0(A)") +(def-read-suppress-test read-suppress.sharp-left-paren.6 "#1(A)") +(def-read-suppress-test read-suppress.sharp-left-paren.7 "#1(A B C D E)") +(def-read-suppress-test read-suppress.sharp-left-paren.8 "#4(A B C D E)") +(def-read-suppress-test read-suppress.sharp-left-paren.9 "#10(A B C D E)") +(def-read-suppress-test read-suppress.sharp-left-paren.10 "#100()") +(def-read-suppress-test read-suppress.sharp-left-paren.11 "#10000000000000()") +(def-read-suppress-test read-suppress.sharp-left-paren.12 "#10000000000000(A)") + +(def-read-suppress-test read-suppress.sharp-asterisk.1 "#*") +(def-read-suppress-test read-suppress.sharp-asterisk.2 "#0*") +(def-read-suppress-test read-suppress.sharp-asterisk.3 "#*1") +(def-read-suppress-test read-suppress.sharp-asterisk.4 "#*0111001") +(def-read-suppress-test read-suppress.sharp-asterisk.5 "#*73298723497132") +(def-read-suppress-test read-suppress.sharp-asterisk.6 + "#*abcdefghijklmnopqrstuvwxyz") +(def-read-suppress-test read-suppress.sharp-asterisk.7 + "#*ABCDEFGHIJKLMNOPQRSTUVWXYZ") +(def-read-suppress-test read-suppress.sharp-asterisk.8 "#*:") +(def-read-suppress-test read-suppress.sharp-asterisk.9 "#*::::") +(def-read-suppress-test read-suppress.sharp-asterisk.10 "#1*") +(def-read-suppress-test read-suppress.sharp-asterisk.11 "#10000*") +(def-read-suppress-test read-suppress.sharp-asterisk.12 "#10000000000000*") +(def-read-suppress-test read-suppress.sharp-asterisk.13 "#4*001101001") +(def-read-suppress-test read-suppress.sharp-asterisk.14 "#2*") + +(def-read-suppress-test read-suppress.sharp-colon.1 "#:1") +(def-read-suppress-test read-suppress.sharp-colon.2 "#:foo") +(def-read-suppress-test read-suppress.sharp-colon.3 "#0:1/2") +(def-read-suppress-test read-suppress.sharp-colon.4 "#10:-2") +(def-read-suppress-test read-suppress.sharp-colon.5 "#100000000000:x") +(def-read-suppress-test read-suppress.sharp-colon.6 "#3:foo") +(def-read-suppress-test read-suppress.sharp-colon.7 "#::") +(def-read-suppress-test read-suppress.sharp-colon.8 "#:123") +(def-read-suppress-test read-suppress.sharp-colon.9 "#:.") + +(def-read-suppress-test read-suppress.sharp-dot.1 "#.1") +(def-read-suppress-test read-suppress.sharp-dot.2 "#.#:foo") +(def-read-suppress-test read-suppress.sharp-dot.3 "#.(throw 'foo nil)") +(def-read-suppress-test read-suppress.sharp-dot.4 "#0.1") +(def-read-suppress-test read-suppress.sharp-dot.5 "#10.1") +(def-read-suppress-test read-suppress.sharp-dot.6 "#1000000000000000.1") + +(def-read-suppress-test read-suppress.sharp-b.1 "#b0") +(def-read-suppress-test read-suppress.sharp-b.2 "#B1") +(def-read-suppress-test read-suppress.sharp-b.3 "#BX") +(def-read-suppress-test read-suppress.sharp-b.4 "#b.") +(def-read-suppress-test read-suppress.sharp-b.5 "#0b0") +(def-read-suppress-test read-suppress.sharp-b.6 "#1B1") +(def-read-suppress-test read-suppress.sharp-b.7 "#100b010") +(def-read-suppress-test read-suppress.sharp-b.8 "#1000000000000b010") +(def-read-suppress-test read-suppress.sharp-b.9 "#B101/100") +(def-read-suppress-test read-suppress.sharp-b.10 "#b101/100/11") + +(def-read-suppress-test read-suppress.sharp-o.1 "#o0") +(def-read-suppress-test read-suppress.sharp-o.2 "#O1") +(def-read-suppress-test read-suppress.sharp-o.3 "#OX") +(def-read-suppress-test read-suppress.sharp-o.4 "#o.") +(def-read-suppress-test read-suppress.sharp-o.5 "#od6") +(def-read-suppress-test read-suppress.sharp-o.6 "#1O9") +(def-read-suppress-test read-suppress.sharp-o.7 "#100O010") +(def-read-suppress-test read-suppress.sharp-o.8 "#1000000000000o27423") +(def-read-suppress-test read-suppress.sharp-o.9 "#O123/457") +(def-read-suppress-test read-suppress.sharp-o.10 "#o12/17/21") + +(def-read-suppress-test read-suppress.sharp-c.1 "#c(0 0)") +(def-read-suppress-test read-suppress.sharp-c.2 "#C(1.0 1.0)") +(def-read-suppress-test read-suppress.sharp-c.3 "#cFOO") +(def-read-suppress-test read-suppress.sharp-c.4 "#c1") +(def-read-suppress-test read-suppress.sharp-c.5 "#C(1 2 3)") +(def-read-suppress-test read-suppress.sharp-c.6 "#c.") +(def-read-suppress-test read-suppress.sharp-c.7 "#c()") +(def-read-suppress-test read-suppress.sharp-c.8 "#c(1)") +(def-read-suppress-test read-suppress.sharp-c.9 "#C(1 . 2)") +(def-read-suppress-test read-suppress.sharp-c.10 "#c(1 2 3)") +(def-read-suppress-test read-suppress.sharp-c.11 "#0c(1 2)") +(def-read-suppress-test read-suppress.sharp-c.12 "#1C(1 2)") +(def-read-suppress-test read-suppress.sharp-c.13 "#10c(1 2)") +(def-read-suppress-test read-suppress.sharp-c.14 "#123456789c(1 2)") +(def-read-suppress-test read-suppress.sharp-c.15 "#c(.)") + +(def-read-suppress-test read-suppress.sharp-x.1 "#x0") +(def-read-suppress-test read-suppress.sharp-x.2 "#X1") +(def-read-suppress-test read-suppress.sharp-x.3 "#XX") +(def-read-suppress-test read-suppress.sharp-x.4 "#x.") +(def-read-suppress-test read-suppress.sharp-x.5 "#xy6") +(def-read-suppress-test read-suppress.sharp-x.6 "#1X9") +(def-read-suppress-test read-suppress.sharp-x.7 "#100X010") +(def-read-suppress-test read-suppress.sharp-x.8 "#1000000000000x2af23") +(def-read-suppress-test read-suppress.sharp-x.9 "#X123/DE7") +(def-read-suppress-test read-suppress.sharp-x.10 "#x12/17/21") + +(def-read-suppress-test read-suppress.sharp-r.1 "#2r1101") +(def-read-suppress-test read-suppress.sharp-r.2 "#10R9871") +(def-read-suppress-test read-suppress.sharp-r.3 "#36r721zwoqnASLDKJA22") +(def-read-suppress-test read-suppress.sharp-r.4 "#r.") +(def-read-suppress-test read-suppress.sharp-r.5 "#2r379ze") +(def-read-suppress-test read-suppress.sharp-r.6 "#0r0") +(def-read-suppress-test read-suppress.sharp-r.7 "#1r0") +(def-read-suppress-test read-suppress.sharp-r.8 "#100r0A") +(def-read-suppress-test read-suppress.sharp-r.9 "#1000000000000r0A") +(def-read-suppress-test read-suppress.sharp-r.10 "#2r!@#$%^&*_-+={}[]:<>.?/") + +(def-read-suppress-test read-suppress.sharp-a.1 "#a()") +(def-read-suppress-test read-suppress.sharp-a.2 "#2a((a)(b c))") +(def-read-suppress-test read-suppress.sharp-a.3 "#a1") +(def-read-suppress-test read-suppress.sharp-a.4 "#1a1") +(def-read-suppress-test read-suppress.sharp-a.5 "#10a(a b c)") +(def-read-suppress-test read-suppress.sharp-a.6 "#100a(a b c)") +(def-read-suppress-test read-suppress.sharp-a.7 "#10000000000000a(a b c)") +(def-read-suppress-test read-suppress.sharp-a.8 "#a.") +(def-read-suppress-test read-suppress.sharp-a.9 "#a(.)") + +(def-read-suppress-test read-suppress.sharp-s.1 "#s()") +(def-read-suppress-test read-suppress.sharp-s.2 "#S(invalid-sname)") +(def-read-suppress-test read-suppress.sharp-s.3 "#s(.)") +(def-read-suppress-test read-suppress.sharp-s.4 "#S(foo bar)") +(def-read-suppress-test read-suppress.sharp-s.5 "#0s()") +(def-read-suppress-test read-suppress.sharp-s.6 "#1S()") +(def-read-suppress-test read-suppress.sharp-s.7 "#10s()") +(def-read-suppress-test read-suppress.sharp-s.8 "#271S()") +(def-read-suppress-test read-suppress.sharp-s.9 "#712897459812s()") + +(def-read-suppress-test read-suppress.sharp-p.1 "#p\"\"") +(def-read-suppress-test read-suppress.sharp-p.2 "#P123") +(def-read-suppress-test read-suppress.sharp-p.3 "#p1/3") +(def-read-suppress-test read-suppress.sharp-p.4 "#0P\"\"") +(def-read-suppress-test read-suppress.sharp-p.5 "#1p\"\"") +(def-read-suppress-test read-suppress.sharp-p.6 "#100P\"\"") +(def-read-suppress-test read-suppress.sharp-p.7 "#1234567890p\"\"") + +(def-read-suppress-test read-suppress.sharp-equal.1 "#=nil") +(def-read-suppress-test read-suppress.sharp-equal.2 "#1=nil") +(def-read-suppress-test read-suppress.sharp-equal.3 "#100=nil") +(def-read-suppress-test read-suppress.sharp-equal.4 "(#1=nil #1=nil)") + +(def-read-suppress-test read-suppress.sharp-sharp.1 "##") +(def-read-suppress-test read-suppress.sharp-sharp.2 "#1#") +(def-read-suppress-test read-suppress.sharp-sharp.3 "#100#") +(def-read-suppress-test read-suppress.sharp-sharp.4 "#123456789#") + +;;; Error cases + +(def-syntax-test read-suppress.error.1 + (signals-error (let ((*read-suppress* t)) (read-from-string "')")) + reader-error) + t) + +(def-syntax-test read-suppress.error.2 + (signals-error (let ((*read-suppress* t)) (read-from-string "#<")) + reader-error) + t) + +(def-syntax-test read-suppress.error.3 + (signals-error (let ((*read-suppress* t)) (read-from-string "# ")) + reader-error) + t) + +(def-syntax-test read-suppress.error.4 + (signals-error (let ((*read-suppress* t)) (read-from-string "#)")) + reader-error) + t) diff --git a/ansi-tests/reader-aux.lsp b/ansi-tests/reader-aux.lsp new file mode 100644 index 0000000000000000000000000000000000000000..40524820f90e242be93d72d7034c0ef6b5e5b796 --- /dev/null +++ b/ansi-tests/reader-aux.lsp @@ -0,0 +1,49 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Fri Jan 14 07:43:48 2005 +;;;; Contains: Auxiliary functions and macros for reader tests + +(in-package :cl-test) + +;;; 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)) + +;;; Macros for testing specific features + +(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))) + +(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))) + +(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))) + +(defmacro def-syntax-array-test (name form expected-result) + `(def-syntax-test ,name + (let ((v (read-from-string ,form))) + (assert (typep v 'simple-array)) + (assert (not (array-has-fill-pointer-p v))) + (assert (eql (array-element-type v) + (upgraded-array-element-type t))) + v) + ,(eval expected-result))) + + diff --git a/ansi-tests/syntax.lsp b/ansi-tests/syntax.lsp index 99af621e2edf68fb2639f2dfebf93282996fad5b..3ad09486f809c81050811cbfb383c0cf9af6db78 100644 --- a/ansi-tests/syntax.lsp +++ b/ansi-tests/syntax.lsp @@ -5,7 +5,8 @@ (in-package :cl-test) -;;; Test that +(compile-and-load "reader-aux.lsp") + (def-syntax-test syntax.whitespace.1 ;; Check that various standard or semistandard characters are whitespace[2] (let ((names '("Tab" "Newline" "Linefeed" "Space" "Return" "Page"))) @@ -300,13 +301,6 @@ ;;; 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 "#()") @@ -347,13 +341,6 @@ ;;; 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 "#*") @@ -416,14 +403,6 @@ ;;; 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") @@ -695,16 +674,6 @@ ;;; Tests of #a -(defmacro def-syntax-array-test (name form expected-result) - `(def-syntax-test ,name - (let ((v (read-from-string ,form))) - (assert (typep v 'simple-array)) - (assert (not (array-has-fill-pointer-p v))) - (assert (eql (array-element-type v) - (upgraded-array-element-type t))) - v) - ,(eval expected-result))) - (def-syntax-array-test syntax.sharp-a.1 "#0anil" (make-array nil :initial-element nil)) @@ -822,8 +791,9 @@ ;;; Tests of #S -(defstruct syntax-test-struct-1 - a b c) +(unless (find-class 'syntax-test-struct-1) + (defstruct syntax-test-struct-1 + a b c)) (def-syntax-test syntax.sharp-s.1 (let ((v (read-from-string "#s(syntax-test-struct-1)"))) @@ -937,6 +907,194 @@ (read-from-string "#p\"syntax.lsp\"")) #.(parse-namestring "syntax.lsp") 14) +(def-syntax-test syntax.sharp-p.5 + (read-from-string "#P#.(make-array '(10) :initial-contents \"syntax.lsp\" :element-type 'base-char)") + #.(parse-namestring "syntax.lsp") 78) + +;;; #<number># and #<number>= + +(def-syntax-test syntax.sharp-circle.1 + (let ((x (read-from-string "(#1=(17) #1#)"))) + (assert (eq (car x) (cadr x))) + x) + ((17) (17))) + +(def-syntax-test syntax.sharp-circle.2 + (let ((x (read-from-string "(#0=(17) #0#)"))) + (assert (eq (car x) (cadr x))) + x) + ((17) (17))) + +(def-syntax-test syntax.sharp-circle.3 + (let ((x (read-from-string "(#123456789123456789=(17) #123456789123456789#)"))) + (assert (eq (car x) (cadr x))) + x) + ((17) (17))) + +(def-syntax-test syntax.sharp-circle.4 + (let ((x (read-from-string "#1=(A B . #1#)"))) + (assert (eq (cddr x) x)) + (values (car x) (cadr x))) + a b) + +(def-syntax-test syntax.sharp-circle.5 + (let ((x (read-from-string "#1=#(A B #1#)"))) + (assert (typep x '(simple-vector 3))) + (assert (eq (elt x 2) x)) + (values (elt x 0) (elt x 1))) + a b) + +(def-syntax-test syntax.sharp-circle.6 + (let ((x (read-from-string "((#1=(17)) #1#)"))) + (assert (eq (caar x) (cadr x))) + x) + (((17)) (17))) + +(def-syntax-test syntax.sharp-circle.7 + (let ((x (read-from-string "((#1=#2=(:x)) #1# #2#)"))) + (assert (eq (caar x) (cadr x))) + (assert (eq (caar x) (caddr x))) + x) + (((:x)) (:x) (:x))) + +;;; #+ + +(def-syntax-test syntax.sharp-plus.1 + (let ((*features* nil)) + (read-from-string "#+X :bad :good")) + :good 14) + +(def-syntax-test syntax.sharp-plus.2 + (let ((*features* '(:a :x :b))) + (read-from-string "#+X :good :bad")) + :good 10) + +(def-syntax-test syntax.sharp-plus.3 + (let ((*features* '(:a :x :b))) + (read-from-string "#+:x :good :bad")) + :good 11) + +(def-syntax-test syntax.sharp-plus.4 + (let ((*features* '(:a :x :b))) + (read-from-string "#+(and):good :bad")) + :good 13) + +(def-syntax-test syntax.sharp-plus.5 + (let ((*features* '(:a :x :b))) + (read-from-string "#+(:and):good :bad")) + :good 14) + +(def-syntax-test syntax.sharp-plus.6 + (let ((*features* '(:a :x :b))) + (read-from-string "#+(or) :bad :good")) + :good 17) + +(def-syntax-test syntax.sharp-plus.7 + (let ((*features* '(:a :x :b))) + (read-from-string "#+(:or) :bad :good")) + :good 18) + +(def-syntax-test syntax.sharp-plus.8 + (let ((*features* '(x))) + (read-from-string "#+X :bad :good")) + :good 14) + +(def-syntax-test syntax.sharp-plus.9 + (let ((*features* '(x))) + (read-from-string "#+CL-TEST::X :good :bad")) + :good 19) + +(def-syntax-test syntax.sharp-plus.10 + (let ((*features* nil)) + (read-from-string "#+(not x) :good :bad")) + :good 16) + +(def-syntax-test syntax.sharp-plus.11 + (let ((*features* '(:x))) + (read-from-string "#+(not x) :bad :good")) + :good 20) + +(def-syntax-test syntax.sharp-plus.12 + (let ((*features* nil)) + (read-from-string "#+(:not :x) :good :bad")) + :good 18) + +(def-syntax-test syntax.sharp-plus.13 + (let ((*features* '(:a :x :b))) + (read-from-string "#+(and a b) :good :bad")) + :good 18) + +(def-syntax-test syntax.sharp-plus.14 + (let ((*features* '(:a :x :b))) + (read-from-string "#+(and a c) :bad :good")) + :good 22) + +(def-syntax-test syntax.sharp-plus.15 + (let ((*features* '(:a :x :b))) + (read-from-string "#+(or c b) :good :bad")) + :good 17) + +(def-syntax-test syntax.sharp-plus.16 + (let ((*features* '(:a :x :b))) + (read-from-string "#+(or c d) :bad :good")) + :good 21) + +;;; Tests of #| |# + +(def-syntax-test syntax.sharp-bar.1 + (read-from-string "#||#1") + 1 5) + +(def-syntax-test syntax.sharp-bar.2 + (read-from-string "1#||#2") + |1##2| 6) + +(def-syntax-test syntax.sharp-bar.3 + (read-from-string "#| #| |# |#1") + 1 12) + +(def-syntax-test syntax.sharp-bar.4 + (read-from-string "#| ; |#1") + 1 8) + +(def-syntax-test syntax.sharp-bar.5 + (read-from-string "#| ( |#1") + 1 8) + +(def-syntax-test syntax.sharp-bar.6 + (read-from-string "#| # |#1") + 1 8) + +(def-syntax-test syntax.sharp-bar.7 + (read-from-string "#| .. |#1") + 1 9) + +(def-syntax-test syntax.sharp-bar.8 + (loop for c across +standard-chars+ + for s = (concatenate 'string "\#| " (string c) " |\#1") + for vals = (multiple-value-list (read-from-string s)) + unless (equal vals '(1 8)) + collect (list c s vals)) + nil) + +(def-syntax-test syntax.sharp-bar.9 + (loop for i below (min (ash 1 16) char-code-limit) + for c = (code-char i) + for s = (and c (concatenate 'string "\#| " (string c) " |\#1")) + for vals = (and c (multiple-value-list (read-from-string s))) + unless (or (not c) (equal vals '(1 8))) + collect (list i c s vals)) + nil) + +(def-syntax-test syntax.sharp-bar.10 + (loop for i = (random (min (ash 1 24) char-code-limit)) + for c = (code-char i) + for s = (and c (concatenate 'string "\#| " (string c) " |\#1")) + for vals = (and c (multiple-value-list (read-from-string s))) + repeat 1000 + unless (or (not c) (equal vals '(1 8))) + collect (list i c s vals)) + nil) ;;;; Various error cases @@ -962,3 +1120,20 @@ (def-syntax-test syntax.sharp-close-paren.1 (signals-error (read-from-string "#)" nil nil) reader-error) t) + +(def-syntax-test syntax.single-escape-eof.1 + (signals-error (read-from-string "\\") end-of-file) + t) + +(def-syntax-test syntax.single-escape-eof.2 + (signals-error (read-from-string "\\" nil nil) end-of-file) + t) + +(def-syntax-test syntax.multiple-escape-eof.1 + (signals-error (read-from-string "|") end-of-file) + t) + +(def-syntax-test syntax.multiple-escape-eof.2 + (signals-error (read-from-string "|" nil nil) end-of-file) + t) +