Commit de9dde47 authored by pfdietz's avatar pfdietz
Browse files

Tests of set-syntax-from-char on #\#

parent 471ccd41
......@@ -77,7 +77,7 @@
(set-syntax-from-char c #\\)
(read-from-string (concatenate 'string (list c #\Z))))))
(unless (equal results '(t |Z|))
(list c results))))))
(list (list c results)))))))
nil)
(deftest set-syntax-from-char.multiple-escape
......@@ -99,7 +99,7 @@
(read-from-string (concatenate 'string (list #\| #\Z c)))
(error (c) c)))))
(unless (or (eql c #\Z) (eql c #\z) (equal results '(t |Z| |z| |Z|)))
(list c results))))))
(list (list c results)))))))
nil)
(deftest set-syntax-from-char.semicolon
......@@ -123,6 +123,336 @@
(read-from-string (concatenate 'string (list c #\2 #\Newline c2)))
(error (c) c)))))
(unless (equal results (list t expected expected expected))
(list c results))))))
(list (list c results)))))))
nil)
\ No newline at end of file
(deftest set-syntax-from-char.left-paren
(loop for c across +standard-chars+
unless (find c ")")
nconc
(with-standard-io-syntax
(let ((*readtable* (copy-readtable nil))
(*package* (find-package "CL-TEST"))
(expected (if (eql c #\0) '(1) '(0)))
(c2 (if (eql c #\0) #\1 #\0)))
(let ((results
(list
(set-syntax-from-char c #\()
(handler-case
(read-from-string (concatenate 'string (list c) ")"))
(error (c) c))
(handler-case
(read-from-string (concatenate 'string (list c c2) ")2" (list #\Newline #\3)))
(error (c) c))
(handler-case
(read-from-string (concatenate 'string (list c c2) ")"))
(error (c) c)))))
(unless (equal results (list t nil expected expected))
(list (list c results)))))))
nil)
(deftest set-syntax-from-char.right-paren
(loop for c across +standard-chars+
nconc
(with-standard-io-syntax
(let ((*readtable* (copy-readtable nil))
(*package* (find-package "CL-TEST")))
(let ((results
(list
(set-syntax-from-char c #\))
(handler-case
(read-from-string (string c) nil nil)
(reader-error (c) :good)
(error (c) c)))))
(unless (equal results '(t :good))
(list (list c results)))))))
nil)
(deftest set-syntax-from-char.single-quote
(loop for c across +standard-chars+
nconc
(with-standard-io-syntax
(let ((*readtable* (copy-readtable nil))
(*package* (find-package "CL-TEST"))
(expected (if (eql c #\0) ''1 ''0))
(c2 (if (eql c #\0) #\1 #\0)))
(let ((results
(list
(set-syntax-from-char c #\')
(handler-case
(read-from-string (concatenate 'string (list c c2)))
(error (c) c))
(handler-case
(read-from-string (concatenate 'string (list c c2) " 2"))
(error (c) c))
(handler-case
(read-from-string (concatenate 'string (list c c2) ")"))
(error (c) c)))))
(unless (equal results (list t expected expected expected))
(list (list c results)))))))
nil)
;;; I do not test that setting syntax from #\" allows the character to be
;;; used as the terminator of a double quoted string. It is not clear that
;;; the standard implies this.
(deftest set-syntax-from-char.double-quote
(loop for c across +standard-chars+
nconc
(with-standard-io-syntax
(let ((*readtable* (copy-readtable nil))
(*package* (find-package "CL-TEST"))
(expected (if (eql c #\0) "1" "0"))
(c2 (if (eql c #\0) #\1 #\0)))
(let ((results
(list
(set-syntax-from-char c #\")
(handler-case
(read-from-string
(concatenate 'string (list c c2 #\")))
(error (c) c))
(handler-case
(read-from-string
(concatenate 'string (list c c2 #\" #\2)))
(error (c) c))
(handler-case
(read-from-string (concatenate 'string (list c c2) "\")"))
(error (c) c)))))
(unless (equal results (list t expected expected expected))
(list (list c results)))))))
nil)
(deftest set-syntax-from-char.backquote
(loop for c across +standard-chars+
unless (find c ",x")
nconc
(with-standard-io-syntax
(let* ((*readtable* (copy-readtable nil))
(*package* (find-package "CL-TEST"))
(c2 (if (eql c #\Space) #\Newline #\Space))
(results
(list
(set-syntax-from-char c #\`)
(handler-case
(eval `(let ((x 0))
,(read-from-string
(concatenate 'string (list c #\, #\x)))))
(error (c) c))
(handler-case
(eval `(let ((x 0))
,(read-from-string
(concatenate 'string (list c #\, #\x c2)))))
(error (c) c))
(handler-case
(eval `(let ((x 0))
,(read-from-string
(concatenate 'string (list c c2 #\, #\x c2)))))
(error (c) c)))))
(unless (equal results '(t 0 0 0))
(list (list c results))))))
nil)
(deftest set-syntax-from-char.comma
(loop for c across +standard-chars+
unless (find c "`x")
nconc
(with-standard-io-syntax
(let* ((*readtable* (copy-readtable nil))
(*package* (find-package "CL-TEST"))
(c2 (if (eql c #\Space) #\Newline #\Space))
(results
(list
(set-syntax-from-char c #\,)
(handler-case
(read-from-string (string c))
(reader-error (c) :good)
(error (c) c))
(handler-case
(eval `(let ((x 0))
,(read-from-string
(concatenate 'string "`" (list c) "x"))))
(error (c) c)))))
(unless (equal results '(t :good 0))
(list (list c results))))))
nil)
;;; Tests of set-syntax-from-char on #\#
(deftest set-syntax-from-char.sharp.1
(loop for c across +standard-chars+
nconc
(with-standard-io-syntax
(let* ((*readtable* (copy-readtable nil))
(*package* (find-package "CL-TEST"))
(results
(list
(set-syntax-from-char c #\#)
(if (not (eql c #\Space))
(handler-case
(read-from-string
(concatenate 'string (list c #\Space)))
(reader-error () :good)
(error (c) c))
:good)
(if (not (find c "'X"))
(handler-case
(read-from-string
(concatenate 'string (list c) "'X"))
(error (c) c))
'#'|X|)
(if (not (find c "(X)"))
(handler-case
(read-from-string
(concatenate 'string (list c) "(X)"))
(error (c) c))
#(|X|))
(if (not (find c ")"))
(handler-case
(read-from-string
(concatenate 'string (list c) ")"))
(reader-error (c) :good)
(error (c) c))
:good)
(if (not (find c "*"))
(handler-case
(read-from-string
(concatenate 'string (list c #\*)))
(error (c) c))
#*)
(if (not (find c ":|"))
(handler-case
(let ((sym (read-from-string
(concatenate 'string (list c) ":||"))))
(and (symbolp sym)
(null (symbol-package sym))
(symbol-name sym)))
(error (c) c))
"")
(handler-case
(read-from-string
(concatenate 'string (list c #\<)))
(reader-error (c) :good)
(error (c) c))
(handler-case
(read-from-string
(concatenate 'string (list c #\\ #\X)))
(error (c) c))
(if (not (find c "1"))
(handler-case
(read-from-string
(concatenate 'string (list c) "|1111|#1"))
(error (c) c))
1)
(if (not (find c "1"))
(handler-case
(read-from-string
(concatenate 'string (list c) "|11#|111|#11|#1"))
(error (c) c))
1)
)))
(unless (equalp results '(t :good #'|X| #(|X|) :good #* "" :good #\X 1 1))
(list (list c results))))))
nil)
(deftest set-syntax-from-char.sharp.2
(loop for c across +standard-chars+
nconc
(with-standard-io-syntax
(let* ((*readtable* (copy-readtable nil))
(*package* (find-package "CL-TEST"))
(results
(list
(set-syntax-from-char c #\#)
(if (not (find c "+XC "))
(handler-case
(let ((*features* (cons ':X *features*)))
(read-from-string
(concatenate 'string (list c) "+X C")))
(error (c) c))
'c)
(if (not (find c "-(OR)"))
(handler-case
(read-from-string
(concatenate 'string (list c) "-(OR)R"))
(error (c) c))
'r)
(if (not (find c ".1"))
(handler-case
(read-from-string
(concatenate 'string (list c) ".1"))
(error (c) c))
1)
(if (not (find c "01aA"))
(handler-case
(list
(read-from-string
(concatenate 'string (list c) "0a1"))
(read-from-string
(concatenate 'string (list c) "0A1")))
(error (c) c))
'(#0a1 #0a1))
(if (not (find c "01bB"))
(handler-case
(list
(read-from-string
(concatenate 'string (list c) "b101"))
(read-from-string
(concatenate 'string (list c) "B011")))
(error (c) c))
'(5 3))
(if (not (find c "cC()12 "))
(handler-case
(list
(read-from-string
(concatenate 'string (list c) "c(1 2)"))
(read-from-string
(concatenate 'string (list c) "C(2 1)")))
(error (c) c))
'(#c(1 2) #c(2 1)))
(if (not (find c "oO0127"))
(handler-case
(list
(read-from-string
(concatenate 'string (list c) "o172"))
(read-from-string
(concatenate 'string (list c) "O7721")))
(error (c) c))
'(#o172 #o7721))
(if (not (find c "pP\""))
(handler-case
(list
(read-from-string
(concatenate 'string (list c) "p\"\""))
(read-from-string
(concatenate 'string (list c) "P\"\"")))
(error (c) c))
'(#p"" #p""))
(if (not (find c "rR0123"))
(handler-case
(list
(read-from-string
(concatenate 'string (list c) "3r210"))
(read-from-string
(concatenate 'string (list c) "3R1111")))
(error (c) c))
'(#3r210 #3r1111))
;;; Add #s test here
(if (not (find c "xX04dF"))
(handler-case
(list
(read-from-string
(concatenate 'string (list c) "x40Fd"))
(read-from-string
(concatenate 'string (list c) "XFd04")))
(error (c) c))
'(#x40fd #xfd04))
)))
(unless (equalp results
'(t c r 1 (#0a1 #0a1) (5 3) (#c(1 2) #c(2 1))
(#o172 #o7721) (#p"" #p"") (#3r210 #3r1111)
(#x40fd #xfd04)))
(list (list c results)))
)))
nil)
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