Commit | Line | Data |
---|---|---|
889975e5 MG |
1 | ;;;; encoding-escapes.test --- test suite for Guile's string encodings -*- mode: scheme; coding: utf-8 -*- |
2 | ;;;; | |
f4bc4e59 | 3 | ;;;; Copyright (C) 2009, 2010, 2011 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 | ||
27 | (define s1 "última") | |
28 | (define s2 "cédula") | |
29 | (define s3 "años") | |
30 | (define s4 "羅生門") | |
31 | ||
32 | (with-test-prefix "internal encoding" | |
33 | ||
34 | (pass-if "ultima" | |
35 | (string=? s1 (string-ints #xfa #x6c #x74 #x69 #x6d #x61))) | |
36 | ||
37 | (pass-if "cedula" | |
38 | (string=? s2 (string-ints #x63 #xe9 #x64 #x75 #x6c #x61))) | |
39 | ||
40 | (pass-if "anos" | |
41 | (string=? s3 (string-ints #x61 #xf1 #x6f #x73))) | |
42 | ||
43 | (pass-if "Rashomon" | |
44 | (string=? s4 (string-ints #x7f85 #x751f #x9580)))) | |
45 | ||
46 | (with-test-prefix "chars" | |
47 | ||
48 | (pass-if "ultima" | |
49 | (list= eqv? (string->list s1) | |
50 | (list #\372 #\l #\t #\i #\m #\a))) | |
51 | ||
52 | (pass-if "cedula" | |
53 | (list= eqv? (string->list s2) | |
54 | (list #\c #\351 #\d #\u #\l #\a))) | |
55 | ||
56 | (pass-if "anos" | |
57 | (list= eqv? (string->list s3) | |
58 | (list #\a #\361 #\o #\s))) | |
59 | ||
60 | (pass-if "Rashomon" | |
61 | (list= eqv? (string->list s4) | |
62 | (list #\77605 #\72437 #\112600)))) | |
63 | ||
64 | ||
65 | ;; Check that an error is flagged on display output when the output | |
66 | ;; error strategy is 'error | |
67 | ||
68 | (with-test-prefix "display output errors" | |
69 | ||
6851d3be LC |
70 | (pass-if "ultima" |
71 | (let ((pt (open-output-string))) | |
72 | (set-port-encoding! pt "ASCII") | |
73 | (set-port-conversion-strategy! pt 'error) | |
74 | (catch 'encoding-error | |
75 | (lambda () | |
76 | (display s1 pt) | |
77 | #f) | |
78 | (lambda (key subr message errno port chr) | |
79 | (and (eq? port pt) | |
80 | (char=? chr (string-ref s1 0)) | |
81 | (string=? (get-output-string pt) "")))))) | |
82 | ||
83 | (pass-if "Rashomon" | |
84 | (let ((pt (open-output-string))) | |
85 | (set-port-encoding! pt "ASCII") | |
86 | (set-port-conversion-strategy! pt 'error) | |
87 | (catch 'encoding-error | |
88 | (lambda () | |
89 | (display s4 pt) | |
90 | #f) | |
91 | (lambda (key subr message errno port chr) | |
92 | (and (eq? port pt) | |
93 | (char=? chr (string-ref s4 0)) | |
94 | (string=? (get-output-string pt) "")))))) | |
889975e5 | 95 | |
6851d3be LC |
96 | (pass-if "tekniko" |
97 | (let ((pt (open-output-string))) | |
98 | (set-port-encoding! pt "ASCII") | |
99 | (set-port-conversion-strategy! pt 'error) | |
100 | (catch 'encoding-error | |
101 | (lambda () | |
102 | ;; This time encoding should fail on the 3rd character. | |
103 | (display "teĥniko" pt) | |
104 | #f) | |
105 | (lambda (key subr message errno port chr) | |
106 | (and (eq? port pt) | |
107 | (char=? chr #\ĥ) | |
108 | (string=? "te" (get-output-string pt)))))))) | |
889975e5 MG |
109 | |
110 | ;; Check that questions marks or substitutions appear when the conversion | |
111 | ;; mode is substitute | |
112 | (with-test-prefix "display output substitutions" | |
113 | ||
114 | (pass-if "ultima" | |
115 | (let ((pt (open-output-string))) | |
116 | (set-port-encoding! pt "ASCII") | |
117 | (set-port-conversion-strategy! pt 'substitute) | |
118 | (display s1 pt) | |
119 | (string=? "?ltima" | |
120 | (get-output-string pt)))) | |
121 | ||
122 | (pass-if "Rashomon" | |
123 | (let ((pt (open-output-string))) | |
124 | (set-port-encoding! pt "ASCII") | |
125 | (set-port-conversion-strategy! pt 'substitute) | |
126 | (display s4 pt) | |
127 | (string=? "???" | |
128 | (get-output-string pt))))) | |
129 | ||
130 | ||
131 | ;; Check that hex escapes appear in the write output and that no error | |
132 | ;; is thrown. The output error strategy should be irrelevant here. | |
133 | (with-test-prefix "display output escapes" | |
134 | ||
135 | (pass-if "ultima" | |
136 | (let ((pt (open-output-string))) | |
137 | (set-port-encoding! pt "ASCII") | |
138 | (set-port-conversion-strategy! pt 'escape) | |
139 | (display s1 pt) | |
140 | (string=? "\\xfaltima" | |
141 | (get-output-string pt)))) | |
142 | (pass-if "Rashomon" | |
ce3ed012 MG |
143 | (let ((pt (open-output-string))) |
144 | (set-port-encoding! pt "ASCII") | |
145 | (set-port-conversion-strategy! pt 'escape) | |
146 | (display s4 pt) | |
f4bc4e59 LC |
147 | (string=? "\\u7f85\\u751f\\u9580" |
148 | (get-output-string pt)))) | |
149 | ||
150 | (pass-if "fake escape" | |
151 | ;; The input string below contains something that looks like | |
152 | ;; an escape in libunistring syntax, but which should be left | |
153 | ;; as is in the output. See | |
154 | ;; <http://lists.gnu.org/archive/html/bug-libunistring/2010-09/msg00004.html> | |
155 | ;; for background info. | |
156 | (let ((pt (open-output-string))) | |
157 | (set-port-encoding! pt "ASCII") | |
158 | (set-port-conversion-strategy! pt 'escape) | |
159 | (display "λ -- \\u0012" pt) | |
160 | (string=? "\\u03bb -- \\u0012" | |
161 | (get-output-string pt))))) | |
889975e5 MG |
162 | |
163 | (with-test-prefix "input escapes" | |
164 | ||
ce3ed012 MG |
165 | (pass-if "última" |
166 | (with-locale "en_US.utf8" | |
167 | (string=? "última" | |
168 | (with-input-from-string "\"\\xfaltima\"" read)))) | |
889975e5 MG |
169 | |
170 | (pass-if "羅生門" | |
ce3ed012 MG |
171 | (with-locale "en_US.utf8" |
172 | (string=? "羅生門" | |
173 | (with-input-from-string | |
174 | "\"\\u7F85\\u751F\\u9580\"" read))))) | |
889975e5 | 175 |