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