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