Commit 30c8387f authored by pfdietz's avatar pfdietz
Browse files

Added tests for readtable-case

parent e4c555ca
......@@ -12,3 +12,5 @@
(load "read-preserving-whitespace.lsp")
(load "read-delimited-list.lsp")
(load "read-from-string.lsp")
(load "readtable-case.lsp")
;-*- 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)
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