diff --git a/reader/readtable-case.lsp b/reader/readtable-case.lsp index 85eec66b1cc71473e1316fd01843598bfa7c35e7..0e9d3a89c311da1458b2d8bfbddf78cccc184261 100644 --- a/reader/readtable-case.lsp +++ b/reader/readtable-case.lsp @@ -5,6 +5,8 @@ (in-package :cl-test) +;;; readtable-case setting + (deftest readtable-case.1 (with-standard-io-syntax (readtable-case *readtable*)) @@ -53,6 +55,35 @@ (list rtc rt2))))) 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 (deftest readtable-case.error.1