source: trunk/source/tests/ansi-tests/char-schar.lsp @ 8991

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

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

File size: 4.1 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sun Sep 29 21:04:44 2002
4;;;; Contains: Tests of CHAR and SCHAR accessors
5
6(in-package :cl-test)
7
8(deftest char.1
9  (let ((s "abcd"))
10    (values (char s 0) (char s 1) (char s 2) (char s 3)))
11  #\a #\b #\c #\d)
12
13(deftest char.2
14  (let ((s0 (copy-seq "abcd"))
15        (s1 (copy-seq "abcd"))
16        (s2 (copy-seq "abcd"))
17        (s3 (copy-seq "abcd")))
18    (setf (char s0 0) #\X)
19    (setf (char s1 1) #\X)
20    (setf (char s2 2) #\X)
21    (setf (char s3 3) #\X)
22    (values s0 s1 s2 s3))
23  "Xbcd" "aXcd" "abXd" "abcX")
24
25(deftest char.3
26  (let ((s (make-array 6 :element-type 'character
27                       :initial-contents '(#\a #\b #\c #\d #\e #\f))))
28    (setf (char s 3) #\X)
29    s)
30  "abcXef")
31
32(deftest char.4
33  (let ((s (make-array 6 :element-type 'character
34                       :initial-contents '(#\a #\b #\c #\d #\e #\f)
35                       :fill-pointer 4)))
36    (setf (char s 3) #\X)
37    s)
38  "abcX")
39
40(deftest char.5
41  (let ((s (make-string 5 :initial-element #\a)))
42    (setf (char s 3) #\X)
43    s)
44  "aaaXa")
45
46(deftest char.6
47  (let ((s (make-string 5 :initial-element #\a :element-type 'base-char)))
48    (setf (char s 3) #\X)
49    s)
50  "aaaXa")
51
52(deftest char.7
53  (let ((s (make-string 5 :initial-element #\a :element-type 'character)))
54    (setf (char s 3) #\X)
55    s)
56  "aaaXa")
57
58(deftest char.8
59  (let ((s (make-array 6 :element-type 'character
60                       :initial-contents '(#\a #\b #\c #\d #\e #\f)
61                       :fill-pointer 4)))
62    (setf (char s 5) #\X)
63    (setf (fill-pointer s) 6)
64    s)
65  "abcdeX")
66
67(deftest char.9
68  (let ((s (make-string 5 :initial-element #\a
69                        :element-type 'base-char)))
70    (setf (char s 3) #\X)
71    s)
72  "aaaXa")
73
74(deftest char.10
75  (let ((s (make-string 5 :initial-element #\a
76                        :element-type 'standard-char)))
77    (setf (char s 3) #\X)
78    s)
79  "aaaXa")
80
81(deftest char.order.1
82  (let ((i 0) a b)
83    (values
84     (char (progn (setf a (incf i)) "abc")
85           (progn (setf b (incf i)) 1))
86     i a b))
87  #\b 2 1 2)
88
89(deftest char.order.2
90  (let ((i 0) a b c (s (make-string 5 :initial-element #\z)))
91    (values
92     (setf
93      (char (progn (setf a (incf i)) s)
94            (progn (setf b (incf i)) 1))
95      (progn (setf c (incf i)) #\a))
96     s i a b c))
97  #\a "zazzz" 3 1 2 3)
98
99;;; Error tests
100
101(deftest char.error.1
102  (signals-error (char) program-error)
103  t)
104
105(deftest char.error.2
106  (signals-error (char "abc") program-error)
107  t)
108
109(deftest char.error.3
110  (signals-error (char "abc" 1 nil) program-error)
111  t)
112
113;;; Tests of schar
114
115(deftest schar.1
116  (let ((s "abcd")) (values (schar s 0) (schar s 1) (schar s 2) (schar s 3)))
117  #\a #\b #\c #\d)
118
119(deftest schar.2
120  (let ((s0 (copy-seq "abcd"))
121        (s1 (copy-seq "abcd"))
122        (s2 (copy-seq "abcd"))
123        (s3 (copy-seq "abcd")))
124    (setf (schar s0 0) #\X)
125    (setf (schar s1 1) #\X)
126    (setf (schar s2 2) #\X)
127    (setf (schar s3 3) #\X)
128    (values s0 s1 s2 s3))
129  "Xbcd" "aXcd" "abXd" "abcX")
130
131(deftest schar.3
132  (let ((s (make-string 6 :initial-element #\x)))
133    (setf (schar s 2) #\X)
134    s)
135  "xxXxxx")
136
137(deftest schar.4
138  (let ((s (make-string 6 :initial-element #\x :element-type 'character)))
139    (setf (schar s 2) #\X)
140    s)
141  "xxXxxx")
142
143(deftest schar.5
144  (let ((s (make-string 6 :initial-element #\x :element-type 'standard-char)))
145    (setf (schar s 2) #\X)
146    s)
147  "xxXxxx")
148
149(deftest schar.6
150  (let ((s (make-string 6 :initial-element #\x :element-type 'base-char)))
151    (setf (schar s 2) #\X)
152    s)
153  "xxXxxx")
154
155(deftest schar.7
156  (let ((s (make-string 6 :initial-element #\x
157                        :element-type 'standard-char)))
158    (setf (schar s 2) #\X)
159    s)
160  "xxXxxx")
161
162(deftest schar.order.1
163  (let ((i 0) a b)
164    (values
165     (schar (progn (setf a (incf i)) "abc")
166            (progn (setf b (incf i)) 1))
167     i a b))
168  #\b 2 1 2)
169
170(deftest schar.order.2
171  (let ((i 0) a b c (s (copy-seq "zzzzz")))
172    (values
173     (setf
174      (schar (progn (setf a (incf i)) s)
175             (progn (setf b (incf i)) 1))
176      (progn (setf c (incf i)) #\a))
177     s i a b c))
178  #\a "zazzz" 3 1 2 3)
179
180;;; Error tests
181
182(deftest schar.error.1
183  (signals-error (schar) program-error)
184  t)
185
186(deftest schar.error.2
187  (signals-error (schar "abc") program-error)
188  t)
189
190(deftest schar.error.3
191  (signals-error (schar "abc" 1 nil) program-error)
192  t)
193
Note: See TracBrowser for help on using the repository browser.