Skip to content
Snippets Groups Projects
Commit f95ae1a6 authored by Daniel Kochmański's avatar Daniel Kochmański
Browse files

tests: readtable-case: test all cases of conversion

parent d2d07659
No related branches found
No related tags found
No related merge requests found
...@@ -5,6 +5,8 @@ ...@@ -5,6 +5,8 @@
(in-package :cl-test) (in-package :cl-test)
;;; readtable-case setting
(deftest readtable-case.1 (deftest readtable-case.1
(with-standard-io-syntax (with-standard-io-syntax
(readtable-case *readtable*)) (readtable-case *readtable*))
...@@ -53,6 +55,35 @@ ...@@ -53,6 +55,35 @@
(list rtc rt2))))) (list rtc rt2)))))
nil) nil)
;; readtable-case reading
(symbol-macrolet ((lookup-table
'(:SYMBOL ("zebra" "Zebra" "ZEBRA" "zebr\\a" "zebr\\A" "ZEBR\\a" "ZEBR\\A" "Zebr\\a" "Zebr\\A")
:UPCASE (|ZEBRA| |ZEBRA| |ZEBRA| |ZEBRa| |ZEBRA| |ZEBRa| |ZEBRA| |ZEBRa| |ZEBRA|)
:DOWNCASE (|zebra| |zebra| |zebra| |zebra| |zebrA| |zebra| |zebrA| |zebra| |zebrA|)
:PRESERVE (|zebra| |Zebra| |ZEBRA| |zebra| |zebrA| |ZEBRa| |ZEBRA| |Zebra| |ZebrA|)
:INVERT (|ZEBRA| |Zebra| |zebra| |ZEBRa| |ZEBRA| |zebra| |zebrA| |Zebra| |ZebrA|))))
(macrolet
((def-readtable-case-test (reader-case)
`(deftest ,(make-symbol (concatenate 'string "READTABLE-CASE.CASE-"
(symbol-name reader-case)))
(let ((*readtable* (copy-readtable)))
(setf (readtable-case *readtable*) ,reader-case)
(mapcar #'(lambda (x)
(read-from-string x))
',(getf lookup-table :symbol)))
,(getf lookup-table reader-case))))
(def-readtable-case-test :upcase)
(def-readtable-case-test :downcase)
(def-readtable-case-test :preserve)
(def-readtable-case-test :invert)))
;; when readtable was :invert quoted characters may get inverted too
(deftest readtable.case.invert-char
(let ((*readtable* (copy-readtable)))
(setf (readtable-case *readtable*) :invert)
(read-from-string "#\\a"))
#\a 3)
;;; Error cases ;;; Error cases
(deftest readtable-case.error.1 (deftest readtable-case.error.1
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment