diff --git a/ansi-tests/load-reader.lsp b/ansi-tests/load-reader.lsp index 8df12bfb06c220abf40f2ccd1cde2a012db75ed9..470948d958a65885c57204536fcda03385d5f080 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 0000000000000000000000000000000000000000..12853fc474ba6c3648e3dc5b6b13a3ee9dcc4295 --- /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)