From 18ee04ed2f0db5ea8bf734d3b64db4cc2f34a53e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= <daniel@turtleware.eu>
Date: Thu, 13 Aug 2015 21:40:43 +0200
Subject: [PATCH] tests: add test-ansi suite stub
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

For now contains readtable case tests.

Signed-off-by: Daniel Kochmański <daniel@turtleware.eu>
---
 src/tests/bugs/doit.lsp      |  1 +
 src/tests/bugs/test-ansi.lsp | 35 +++++++++++++++++++++++++++++++++++
 2 files changed, 36 insertions(+)
 create mode 100644 src/tests/bugs/test-ansi.lsp

diff --git a/src/tests/bugs/doit.lsp b/src/tests/bugs/doit.lsp
index 1f8b527b4..a2eef8699 100644
--- a/src/tests/bugs/doit.lsp
+++ b/src/tests/bugs/doit.lsp
@@ -29,6 +29,7 @@
 (load "universe.lsp")
 (load "ansi-aux.lsp")
 
+(load "test-ansi.lsp")
 (load "sf262--declaim-type-foo-setf-foo.lsp")
 (load "sf272--style-warning-argument-order.lsp")
 (load "sf276--write-hash-readably.lsp")
diff --git a/src/tests/bugs/test-ansi.lsp b/src/tests/bugs/test-ansi.lsp
new file mode 100644
index 000000000..e884a3955
--- /dev/null
+++ b/src/tests/bugs/test-ansi.lsp
@@ -0,0 +1,35 @@
+(in-package :cl-test)
+
+;;;;;;;;;;;;;;;;;;;;;
+;; Readtable tests ;;
+;;;;;;;;;;;;;;;;;;;;;
+
+(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 ,(concatenate 'string "TEST-ANSI.READTABLE.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 characters got inverted too
+(deftest test-ansi.readtable.invert-char
+    (let ((*readtable* (copy-readtable)))
+      (setf (readtable-case *readtable*) :invert)
+      (read-from-string "#\\a"))
+  #\a 3)
+
+