Commit | Line | Data |
---|---|---|
a5229ee8 | 1 | ;;;; encoding-utf8.test --- test suite for Guile's string encodings -*- mode: scheme; coding: utf-8 -*- |
889975e5 | 2 | ;;;; |
0ce22459 | 3 | ;;;; Copyright (C) 2009, 2010, 2014 Free Software Foundation, Inc. |
a5229ee8 LC |
4 | ;;;; |
5 | ;;;; This library is free software; you can redistribute it and/or | |
6 | ;;;; modify it under the terms of the GNU Lesser General Public | |
7 | ;;;; License as published by the Free Software Foundation; either | |
8 | ;;;; version 3 of the License, or (at your option) any later version. | |
9 | ;;;; | |
10 | ;;;; This library is distributed in the hope that it will be useful, | |
889975e5 | 11 | ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
a5229ee8 LC |
12 | ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
13 | ;;;; Lesser General Public License for more details. | |
14 | ;;;; | |
15 | ;;;; You should have received a copy of the GNU Lesser General Public | |
16 | ;;;; License along with this library; if not, write to the Free Software | |
17 | ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA | |
889975e5 MG |
18 | |
19 | (define-module (test-strings) | |
20 | #:use-module (test-suite lib) | |
21 | #:use-module (srfi srfi-1)) | |
22 | ||
889975e5 MG |
23 | ;; Create a string from integer char values, eg. (string-ints 65) => "A" |
24 | (define (string-ints . args) | |
25 | (apply string (map integer->char args))) | |
26 | ||
0ce22459 MW |
27 | (when (defined? 'setlocale) |
28 | (setlocale LC_ALL "")) | |
889975e5 | 29 | |
bda0d85f MG |
30 | (define ascii-a (integer->char 65)) ; LATIN CAPITAL LETTER A |
31 | (define a-acute (integer->char #x00c1)) ; LATIN CAPITAL LETTER A WITH ACUTE | |
32 | (define alpha (integer->char #x03b1)) ; GREEK SMALL LETTER ALPHA | |
33 | (define cherokee-a (integer->char #x13a0)) ; CHEROKEE LETTER A | |
34 | ||
35 | (with-test-prefix "characters" | |
36 | (pass-if "input A" | |
37 | (char=? ascii-a #\A)) | |
38 | ||
39 | (pass-if "input A acute" | |
40 | (char=? a-acute #\Á)) | |
41 | ||
42 | (pass-if "input alpha" | |
43 | (char=? alpha #\α)) | |
44 | ||
45 | (pass-if "input Cherokee A" | |
46 | (char=? cherokee-a #\Ꭰ)) | |
47 | ||
48 | (pass-if "display A" | |
49 | (let ((pt (open-output-string))) | |
50 | (set-port-encoding! pt "UTF-8") | |
51 | (set-port-conversion-strategy! pt 'substitute) | |
52 | (display ascii-a pt) | |
53 | (string=? "A" | |
54 | (get-output-string pt)))) | |
55 | ||
56 | (pass-if "display A acute" | |
57 | (let ((pt (open-output-string))) | |
58 | (set-port-encoding! pt "UTF-8") | |
59 | (set-port-conversion-strategy! pt 'substitute) | |
60 | (display a-acute pt) | |
61 | (string=? "Á" | |
62 | (get-output-string pt)))) | |
63 | ||
64 | (pass-if "display alpha" | |
65 | (let ((pt (open-output-string))) | |
66 | (set-port-encoding! pt "UTF-8") | |
67 | (set-port-conversion-strategy! pt 'substitute) | |
68 | (display alpha pt) | |
69 | (string-ci=? "α" | |
70 | (get-output-string pt)))) | |
71 | ||
72 | (pass-if "display Cherokee A" | |
73 | (let ((pt (open-output-string))) | |
74 | (set-port-encoding! pt "UTF-8") | |
75 | (set-port-conversion-strategy! pt 'substitute) | |
76 | (display cherokee-a pt) | |
77 | (string-ci=? "Ꭰ" | |
78 | (get-output-string pt)))) | |
79 | ||
80 | (pass-if "write A" | |
81 | (let ((pt (open-output-string))) | |
82 | (set-port-encoding! pt "UTF-8") | |
83 | (set-port-conversion-strategy! pt 'escape) | |
84 | (write ascii-a pt) | |
85 | (string=? "#\\A" | |
86 | (get-output-string pt)))) | |
87 | ||
88 | (pass-if "write A acute" | |
89 | (let ((pt (open-output-string))) | |
90 | (set-port-encoding! pt "UTF-8") | |
91 | (set-port-conversion-strategy! pt 'escape) | |
92 | (write a-acute pt) | |
93 | (string=? "#\\Á" | |
94 | (get-output-string pt)))) | |
95 | ||
33d92fe6 LC |
96 | (pass-if "write A followed by combining accent" |
97 | (let ((pt (open-output-string))) | |
98 | (set-port-encoding! pt "UTF-8") | |
99 | (set-port-conversion-strategy! pt 'escape) | |
100 | (write (string #\A (integer->char #x030f)) pt) | |
101 | (string-ci=? "\"Ȁ\"" | |
102 | (get-output-string pt)))) | |
103 | ||
bda0d85f MG |
104 | (pass-if "write alpha" |
105 | (let ((pt (open-output-string))) | |
106 | (set-port-encoding! pt "UTF-8") | |
107 | (set-port-conversion-strategy! pt 'escape) | |
108 | (write alpha pt) | |
109 | (string=? "#\\α" | |
110 | (get-output-string pt)))) | |
111 | ||
112 | (pass-if "write Cherokee A" | |
113 | (let ((pt (open-output-string))) | |
114 | (set-port-encoding! pt "UTF-8") | |
115 | (set-port-conversion-strategy! pt 'escape) | |
116 | (write cherokee-a pt) | |
117 | (string=? "#\\Ꭰ" | |
118 | (get-output-string pt))))) | |
119 | ||
889975e5 MG |
120 | (define s1 "última") |
121 | (define s2 "cédula") | |
122 | (define s3 "años") | |
123 | (define s4 "羅生門") | |
124 | ||
125 | (with-test-prefix "string length" | |
126 | ||
127 | (pass-if "última" | |
764246cf | 128 | (eqv? (string-length s1) 6)) |
889975e5 MG |
129 | |
130 | (pass-if "cédula" | |
764246cf | 131 | (eqv? (string-length s2) 6)) |
889975e5 MG |
132 | |
133 | (pass-if "años" | |
764246cf | 134 | (eqv? (string-length s3) 4)) |
889975e5 MG |
135 | |
136 | (pass-if "羅生門" | |
764246cf | 137 | (eqv? (string-length s4) 3))) |
889975e5 MG |
138 | |
139 | (with-test-prefix "internal encoding" | |
140 | ||
141 | (pass-if "última" | |
142 | (string=? s1 (string-ints #xfa #x6c #x74 #x69 #x6d #x61))) | |
143 | ||
144 | (pass-if "cédula" | |
145 | (string=? s2 (string-ints #x63 #xe9 #x64 #x75 #x6c #x61))) | |
146 | ||
147 | (pass-if "años" | |
148 | (string=? s3 (string-ints #x61 #xf1 #x6f #x73))) | |
149 | ||
150 | (pass-if "羅生門" | |
151 | (string=? s4 (string-ints #x7f85 #x751f #x9580)))) | |
152 | ||
153 | (with-test-prefix "chars" | |
154 | ||
155 | (pass-if "última" | |
156 | (list= eqv? (string->list s1) | |
157 | (list #\ú #\l #\t #\i #\m #\a))) | |
158 | ||
159 | (pass-if "cédula" | |
160 | (list= eqv? (string->list s2) | |
161 | (list #\c #\é #\d #\u #\l #\a))) | |
162 | ||
163 | (pass-if "años" | |
164 | (list= eqv? (string->list s3) | |
165 | (list #\a #\ñ #\o #\s))) | |
166 | ||
167 | (pass-if "羅生門" | |
168 | (list= eqv? (string->list s4) | |
169 | (list #\羅 #\生 #\門)))) | |
170 | ||
171 | (with-test-prefix "symbols == strings" | |
172 | ||
173 | (pass-if "última" | |
174 | (eq? (string->symbol s1) 'última)) | |
175 | ||
176 | (pass-if "cédula" | |
177 | (eq? (string->symbol s2) 'cédula)) | |
178 | ||
179 | (pass-if "años" | |
180 | (eq? (string->symbol s3) 'años)) | |
181 | ||
182 | (pass-if "羅生門" | |
183 | (eq? (string->symbol s4) '羅生門))) | |
184 | ||
185 | (with-test-prefix "non-ascii variable names" | |
186 | ||
187 | (pass-if "1" | |
188 | (let ((芥川龍之介 1) | |
189 | (ñ 2)) | |
764246cf | 190 | (eqv? (+ 芥川龍之介 ñ) 3)))) |