From 30c8387fcc824c8b75e78c5b1eb5eb422b6bb288 Mon Sep 17 00:00:00 2001
From: pfdietz <pfdietz@localhost>
Date: Sun, 2 Jan 2005 00:58:54 +0000
Subject: [PATCH] Added tests for readtable-case

---
 ansi-tests/load-reader.lsp    |  2 +
 ansi-tests/readtable-case.lsp | 91 +++++++++++++++++++++++++++++++++++
 2 files changed, 93 insertions(+)
 create mode 100644 ansi-tests/readtable-case.lsp

diff --git a/ansi-tests/load-reader.lsp b/ansi-tests/load-reader.lsp
index 8df12bfb..470948d9 100644
--- a/ansi-tests/load-reader.lsp
+++ b/ansi-tests/load-reader.lsp
@@ -12,3 +12,5 @@
 (load "read-preserving-whitespace.lsp")
 (load "read-delimited-list.lsp")
 (load "read-from-string.lsp")
+(load "readtable-case.lsp")
+
diff --git a/ansi-tests/readtable-case.lsp b/ansi-tests/readtable-case.lsp
new file mode 100644
index 00000000..12853fc4
--- /dev/null
+++ b/ansi-tests/readtable-case.lsp
@@ -0,0 +1,91 @@
+;-*- Mode:     Lisp -*-
+;;;; Author:   Paul Dietz
+;;;; Created:  Sat Jan  1 18:43:46 2005
+;;;; Contains: Tests of READTABLE-CASE
+
+(in-package :cl-test)
+
+(deftest readtable-case.1
+  (with-standard-io-syntax
+   (readtable-case *readtable*))
+  :upcase)
+
+(deftest readtable-case.2
+  (with-standard-io-syntax
+   (let ((rt (copy-readtable)))
+     (readtable-case rt)))
+  :upcase)
+
+(deftest readtable-case.3
+  (let ((rt (copy-readtable)))
+    (values
+     (setf (readtable-case rt) :upcase)
+     (readtable-case rt)))
+  :upcase :upcase)
+
+(deftest readtable-case.4
+  (let ((rt (copy-readtable)))
+    (values
+     (setf (readtable-case rt) :downcase)
+     (readtable-case rt)))
+  :downcase :downcase)
+
+(deftest readtable-case.5
+  (let ((rt (copy-readtable)))
+    (values
+     (setf (readtable-case rt) :preserve)
+     (readtable-case rt)))
+  :preserve :preserve)
+
+(deftest readtable-case.6
+  (let ((rt (copy-readtable)))
+    (values
+     (setf (readtable-case rt) :invert)
+     (readtable-case rt)))
+  :invert :invert)
+
+(deftest readtable-case.7
+  (let ((rt (copy-readtable)))
+    (loop for rtc in '(:upcase :downcase :preserve :invert)
+	  do (setf (readtable-case rt) rtc)
+	  nconc (let ((rt2 (copy-readtable rt)))
+		  (unless (eq (readtable-case rt2) rtc)
+		    (list rtc rt2)))))
+  nil)
+
+;;; Error cases
+
+(deftest readtable-case.error.1
+  (signals-error (readtable-case) program-error)
+  t)
+
+(deftest readtable-case.error.2
+  (signals-error (readtable-case *readtable* nil) program-error)
+  t)
+
+(deftest readtable-case.error.3
+  (loop for x in *mini-universe*
+	for form = `(signals-error (readtable-case ',x) type-error)
+	unless (or (typep x 'readtable)
+		   (eql (eval form) t))
+	collect (list x form))
+  nil)
+
+(deftest readtable-case.error.4
+  (loop for x in *mini-universe*
+	for form = `(signals-error (let ((rt (copy-readtable)))
+				     (setf (readtable-case rt) ',x))
+				   type-error)
+	unless (or (member x '(:upcase :downcase :preserve :invert))
+		   (eql (eval form) t))
+	collect x)
+  nil)
+
+(deftest readtable-case.error.5
+  (loop for x in *mini-universe*
+	for form = `(signals-error (setf (readtable-case ',x) :upcase)
+				   type-error)
+	unless (or (typep x 'readtable)
+		   (eql (eval form) t))
+	collect x)
+  nil)
-- 
GitLab