source: trunk/source/tests/ansi-tests/readtable-case.lsp @ 8991

Last change on this file since 8991 was 8991, checked in by gz, 12 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

File size: 1.9 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sat Jan  1 18:43:46 2005
4;;;; Contains: Tests of READTABLE-CASE
5
6(in-package :cl-test)
7
8(deftest readtable-case.1
9  (with-standard-io-syntax
10   (readtable-case *readtable*))
11  :upcase)
12
13(deftest readtable-case.2
14  (with-standard-io-syntax
15   (let ((rt (copy-readtable)))
16     (readtable-case rt)))
17  :upcase)
18
19(deftest readtable-case.3
20  (let ((rt (copy-readtable)))
21    (values
22     (setf (readtable-case rt) :upcase)
23     (readtable-case rt)))
24  :upcase :upcase)
25
26(deftest readtable-case.4
27  (let ((rt (copy-readtable)))
28    (values
29     (setf (readtable-case rt) :downcase)
30     (readtable-case rt)))
31  :downcase :downcase)
32
33(deftest readtable-case.5
34  (let ((rt (copy-readtable)))
35    (values
36     (setf (readtable-case rt) :preserve)
37     (readtable-case rt)))
38  :preserve :preserve)
39
40(deftest readtable-case.6
41  (let ((rt (copy-readtable)))
42    (values
43     (setf (readtable-case rt) :invert)
44     (readtable-case rt)))
45  :invert :invert)
46
47(deftest readtable-case.7
48  (let ((rt (copy-readtable)))
49    (loop for rtc in '(:upcase :downcase :preserve :invert)
50          do (setf (readtable-case rt) rtc)
51          nconc (let ((rt2 (copy-readtable rt)))
52                  (unless (eq (readtable-case rt2) rtc)
53                    (list rtc rt2)))))
54  nil)
55
56;;; Error cases
57
58(deftest readtable-case.error.1
59  (signals-error (readtable-case) program-error)
60  t)
61
62(deftest readtable-case.error.2
63  (signals-error (readtable-case *readtable* nil) program-error)
64  t)
65
66(deftest readtable-case.error.3
67  (check-type-error #'readtable-case (typef 'readtable))
68  nil)
69
70(deftest readtable-case.error.4
71  (check-type-error #'(lambda (x)
72                        (let ((rt (copy-readtable)))
73                          (setf (readtable-case rt) x)))
74                    (typef '(member :upcase :downcase :preserve :invert)))
75  nil)
76
77(deftest readtable-case.error.5
78  (check-type-error #'(lambda (x) (setf (readtable-case x) :upcase))
79                    (typef 'readtable))
80  nil)
81
Note: See TracBrowser for help on using the repository browser.