Commit | Line | Data |
---|---|---|
9aa2c796 JB |
1 | ;;;; strings.test --- test suite for Guile's string functions -*- scheme -*- |
2 | ;;;; Jim Blandy <jimb@red-bean.com> --- August 1999 | |
3 | ;;;; | |
3ae3166b | 4 | ;;;; Copyright (C) 1999, 2001, 2004, 2005, 2006, 2008 Free Software Foundation, Inc. |
9aa2c796 | 5 | ;;;; |
53befeb7 NJ |
6 | ;;;; This library is free software; you can redistribute it and/or |
7 | ;;;; modify it under the terms of the GNU Lesser General Public | |
8 | ;;;; License as published by the Free Software Foundation; either | |
9 | ;;;; version 3 of the License, or (at your option) any later version. | |
9aa2c796 | 10 | ;;;; |
53befeb7 | 11 | ;;;; This library is distributed in the hope that it will be useful, |
9aa2c796 | 12 | ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
53befeb7 NJ |
13 | ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
14 | ;;;; Lesser General Public License for more details. | |
9aa2c796 | 15 | ;;;; |
53befeb7 NJ |
16 | ;;;; You should have received a copy of the GNU Lesser General Public |
17 | ;;;; License along with this library; if not, write to the Free Software | |
18 | ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA | |
9aa2c796 | 19 | |
6e7d5622 KR |
20 | (define-module (test-strings) |
21 | #:use-module (test-suite lib)) | |
22 | ||
9aa2c796 | 23 | |
d7e4c2da MV |
24 | (define exception:read-only-string |
25 | (cons 'misc-error "^string is read-only")) | |
548b9252 | 26 | |
6e7d5622 KR |
27 | ;; Create a string from integer char values, eg. (string-ints 65) => "A" |
28 | (define (string-ints . args) | |
29 | (apply string (map integer->char args))) | |
30 | ||
31 | ||
32 | ;; | |
33 | ;; string=? | |
34 | ;; | |
35 | ||
049fa449 DH |
36 | (with-test-prefix "string=?" |
37 | ||
38 | (pass-if "respects 1st parameter's string length" | |
39 | (not (string=? "foo\0" "foo"))) | |
40 | ||
41 | (pass-if "respects 2nd paramter's string length" | |
42 | (not (string=? "foo" "foo\0"))) | |
43 | ||
44 | (with-test-prefix "wrong argument type" | |
45 | ||
46 | (pass-if-exception "1st argument symbol" | |
47 | exception:wrong-type-arg | |
48 | (string=? 'a "a")) | |
49 | ||
50 | (pass-if-exception "2nd argument symbol" | |
51 | exception:wrong-type-arg | |
52 | (string=? "a" 'b)))) | |
53 | ||
6e7d5622 KR |
54 | ;; |
55 | ;; string<? | |
56 | ;; | |
57 | ||
049fa449 DH |
58 | (with-test-prefix "string<?" |
59 | ||
60 | (pass-if "respects string length" | |
61 | (and (not (string<? "foo\0a" "foo\0a")) | |
62 | (string<? "foo\0a" "foo\0b"))) | |
63 | ||
64 | (with-test-prefix "wrong argument type" | |
65 | ||
66 | (pass-if-exception "1st argument symbol" | |
67 | exception:wrong-type-arg | |
68 | (string<? 'a "a")) | |
69 | ||
70 | (pass-if-exception "2nd argument symbol" | |
71 | exception:wrong-type-arg | |
6e7d5622 KR |
72 | (string<? "a" 'b))) |
73 | ||
74 | (pass-if "same as char<?" | |
75 | (eq? (char<? (integer->char 0) (integer->char 255)) | |
76 | (string<? (string-ints 0) (string-ints 255))))) | |
77 | ||
78 | ;; | |
79 | ;; string-ci<? | |
80 | ;; | |
049fa449 DH |
81 | |
82 | (with-test-prefix "string-ci<?" | |
83 | ||
84 | (pass-if "respects string length" | |
85 | (and (not (string-ci<? "foo\0a" "foo\0a")) | |
86 | (string-ci<? "foo\0a" "foo\0b"))) | |
87 | ||
88 | (with-test-prefix "wrong argument type" | |
89 | ||
90 | (pass-if-exception "1st argument symbol" | |
91 | exception:wrong-type-arg | |
92 | (string-ci<? 'a "a")) | |
93 | ||
94 | (pass-if-exception "2nd argument symbol" | |
95 | exception:wrong-type-arg | |
6e7d5622 KR |
96 | (string-ci<? "a" 'b))) |
97 | ||
98 | (pass-if "same as char-ci<?" | |
99 | (eq? (char-ci<? (integer->char 0) (integer->char 255)) | |
100 | (string-ci<? (string-ints 0) (string-ints 255))))) | |
101 | ||
102 | ;; | |
103 | ;; string<=? | |
104 | ;; | |
105 | ||
106 | (with-test-prefix "string<=?" | |
107 | ||
108 | (pass-if "same as char<=?" | |
109 | (eq? (char<=? (integer->char 0) (integer->char 255)) | |
110 | (string<=? (string-ints 0) (string-ints 255))))) | |
111 | ||
112 | ;; | |
113 | ;; string-ci<=? | |
114 | ;; | |
115 | ||
116 | (with-test-prefix "string-ci<=?" | |
117 | ||
118 | (pass-if "same as char-ci<=?" | |
119 | (eq? (char-ci<=? (integer->char 0) (integer->char 255)) | |
120 | (string-ci<=? (string-ints 0) (string-ints 255))))) | |
121 | ||
122 | ;; | |
123 | ;; string>? | |
124 | ;; | |
125 | ||
126 | (with-test-prefix "string>?" | |
127 | ||
128 | (pass-if "same as char>?" | |
129 | (eq? (char>? (integer->char 0) (integer->char 255)) | |
130 | (string>? (string-ints 0) (string-ints 255))))) | |
131 | ||
132 | ;; | |
133 | ;; string-ci>? | |
134 | ;; | |
135 | ||
136 | (with-test-prefix "string-ci>?" | |
137 | ||
138 | (pass-if "same as char-ci>?" | |
139 | (eq? (char-ci>? (integer->char 0) (integer->char 255)) | |
140 | (string-ci>? (string-ints 0) (string-ints 255))))) | |
141 | ||
142 | ;; | |
143 | ;; string>=? | |
144 | ;; | |
145 | ||
146 | (with-test-prefix "string>=?" | |
147 | ||
148 | (pass-if "same as char>=?" | |
149 | (eq? (char>=? (integer->char 0) (integer->char 255)) | |
150 | (string>=? (string-ints 0) (string-ints 255))))) | |
151 | ||
152 | ;; | |
153 | ;; string-ci>=? | |
154 | ;; | |
155 | ||
156 | (with-test-prefix "string-ci>=?" | |
157 | ||
158 | (pass-if "same as char-ci>=?" | |
159 | (eq? (char-ci>=? (integer->char 0) (integer->char 255)) | |
160 | (string-ci>=? (string-ints 0) (string-ints 255))))) | |
161 | ||
3ae3166b LC |
162 | ;; |
163 | ;; string-ref | |
164 | ;; | |
165 | ||
166 | (with-test-prefix "string-ref" | |
167 | ||
168 | (pass-if-exception "empty string" | |
169 | exception:out-of-range | |
170 | (string-ref "" 0)) | |
171 | ||
172 | (pass-if-exception "empty string and non-zero index" | |
173 | exception:out-of-range | |
174 | (string-ref "" 123)) | |
175 | ||
176 | (pass-if-exception "out of range" | |
177 | exception:out-of-range | |
178 | (string-ref "hello" 123)) | |
179 | ||
180 | (pass-if-exception "negative index" | |
181 | exception:out-of-range | |
182 | (string-ref "hello" -1)) | |
183 | ||
184 | (pass-if "regular string" | |
185 | (char=? (string-ref "GNU Guile" 4) #\G))) | |
186 | ||
6e7d5622 KR |
187 | ;; |
188 | ;; string-set! | |
189 | ;; | |
049fa449 DH |
190 | |
191 | (with-test-prefix "string-set!" | |
192 | ||
3ae3166b LC |
193 | (pass-if-exception "empty string" |
194 | exception:out-of-range | |
195 | (string-set! (string-copy "") 0 #\x)) | |
196 | ||
197 | (pass-if-exception "empty string and non-zero index" | |
198 | exception:out-of-range | |
199 | (string-set! (string-copy "") 123 #\x)) | |
200 | ||
201 | (pass-if-exception "out of range" | |
202 | exception:out-of-range | |
203 | (string-set! (string-copy "hello") 123 #\x)) | |
204 | ||
205 | (pass-if-exception "negative index" | |
206 | exception:out-of-range | |
207 | (string-set! (string-copy "hello") -1 #\x)) | |
208 | ||
b144a33c | 209 | (pass-if-exception "read-only string" |
d7e4c2da | 210 | exception:read-only-string |
3ae3166b LC |
211 | (string-set! (substring/read-only "abc" 0) 1 #\space)) |
212 | ||
213 | (pass-if "regular string" | |
214 | (let ((s (string-copy "GNU guile"))) | |
215 | (string-set! s 4 #\G) | |
216 | (char=? (string-ref s 4) #\G)))) | |
217 | ||
049fa449 | 218 | |
50e20a60 KR |
219 | (with-test-prefix "string-split" |
220 | ||
221 | ;; in guile 1.6.7 and earlier, character >=128 wasn't matched in the string | |
222 | (pass-if "char 255" | |
223 | (equal? '("a" "b") | |
224 | (string-split (string #\a (integer->char 255) #\b) | |
225 | (integer->char 255))))) | |
226 | ||
049fa449 DH |
227 | (with-test-prefix "substring-move!" |
228 | ||
229 | (pass-if-exception "substring-move! checks start and end correctly" | |
230 | exception:out-of-range | |
231 | (substring-move! "sample" 3 0 "test" 3))) | |
1c17f6b0 MV |
232 | |
233 | (with-test-prefix "substring/shared" | |
234 | ||
235 | (pass-if "modify indirectly" | |
236 | (let ((str (string-copy "foofoofoo"))) | |
237 | (string-upcase! (substring/shared str 3 6)) | |
238 | (string=? str "fooFOOfoo"))) | |
239 | ||
240 | (pass-if "modify cow indirectly" | |
241 | (let* ((str1 (string-copy "foofoofoo")) | |
242 | (str2 (string-copy str1))) | |
243 | (string-upcase! (substring/shared str2 3 6)) | |
244 | (and (string=? str1 "foofoofoo") | |
7aa29a87 MV |
245 | (string=? str2 "fooFOOfoo")))) |
246 | ||
247 | (pass-if "modify double indirectly" | |
d7e4c2da | 248 | (let* ((str1 (string-copy "foofoofoo")) |
7aa29a87 MV |
249 | (str2 (substring/shared str1 2 7))) |
250 | (string-upcase! (substring/shared str2 1 4)) | |
251 | (string=? str1 "fooFOOfoo"))) | |
252 | ||
253 | (pass-if "modify cow double indirectly" | |
254 | (let* ((str1 "foofoofoo") | |
255 | (str2 (substring str1 2 7))) | |
256 | (string-upcase! (substring/shared str2 1 4)) | |
257 | (and (string=? str1 "foofoofoo") | |
258 | (string=? str2 "oFOOf"))))) |