1;;;; encoding-iso88591.test --- test suite for Guile's string encodings    -*- mode: scheme; coding: iso-8859-1 -*-
2;;;;
3;;;; Copyright (C) 2009, 2010, 2014 Free Software Foundation, Inc.
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,
11;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
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
18
19(define-module (test-strings)
20  #:use-module (test-suite lib)
21  #:use-module (srfi srfi-1))
22
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;; Set locale to the environment's locale, so that the prints look OK.
28(when (defined? 'setlocale)
29  (setlocale LC_ALL ""))
30
31(define ascii-a (integer->char 65))     ; LATIN CAPITAL LETTER A
32(define a-acute (integer->char #x00c1)) ; LATIN CAPITAL LETTER A WITH ACUTE
33(define alpha (integer->char #x03b1))   ; GREEK SMALL LETTER ALPHA
34(define cherokee-a (integer->char #x13a0)) ; CHEROKEE LETTER A
35
36(with-test-prefix "characters"
37  (pass-if "input A"
38    (char=? ascii-a #\A))
39
40  (pass-if "input A acute"
41    (char=? a-acute #\�))
42
43  (pass-if "display A"
44           (let ((pt (open-output-string)))
45             (set-port-encoding! pt "ISO-8859-1")
46             (set-port-conversion-strategy! pt 'escape)
47             (display ascii-a pt)
48             (string=? "A"
49                       (get-output-string pt))))
50
51  (pass-if "display A acute"
52           (let ((pt (open-output-string)))
53             (set-port-encoding! pt "ISO-8859-1")
54             (set-port-conversion-strategy! pt 'escape)
55             (display a-acute pt)
56             (string=? "�"
57                       (get-output-string pt))))
58
59  (pass-if "display alpha"
60           (let ((pt (open-output-string)))
61             (set-port-encoding! pt "ISO-8859-1")
62             (set-port-conversion-strategy! pt 'escape)
63             (display alpha pt)
64             (string-ci=? "\\u03b1"
65                       (get-output-string pt))))
66
67  (pass-if "display Cherokee a"
68           (let ((pt (open-output-string)))
69             (set-port-encoding! pt "ISO-8859-1")
70             (set-port-conversion-strategy! pt 'escape)
71             (display cherokee-a pt)
72             (string-ci=? "\\u13a0"
73                       (get-output-string pt))))
74
75  (pass-if "write A"
76           (let ((pt (open-output-string)))
77             (set-port-encoding! pt "ISO-8859-1")
78             (set-port-conversion-strategy! pt 'escape)
79             (write ascii-a pt)
80             (string=? "#\\A"
81                       (get-output-string pt))))
82
83  (pass-if "write A acute"
84           (let ((pt (open-output-string)))
85             (set-port-encoding! pt "ISO-8859-1")
86             (set-port-conversion-strategy! pt 'escape)
87             (write a-acute pt)
88             (string=? "#\\�"
89                       (get-output-string pt))))
90
91  (pass-if "write A followed by combining accent"
92           (let ((pt (open-output-string)))
93             (set-port-encoding! pt "ISO-8859-1")
94             (set-port-conversion-strategy! pt 'escape)
95             (write (string #\A (integer->char #x030f)) pt)
96             (string-ci=? "\"A\\u030f\""
97                          (get-output-string pt)))))
98
99
100(define s1 "�ltima")
101(define s2 "c�dula")
102(define s3 "a�os")
103(define s4 "�C�mo?")
104
105(with-test-prefix "string length"
106
107  (pass-if "�ltima"
108	   (eqv? (string-length s1) 6))
109
110  (pass-if "c�dula"
111	   (eqv? (string-length s2) 6))
112
113  (pass-if "a�os"
114	   (eqv? (string-length s3) 4))
115
116  (pass-if "�C�mo?"
117	   (eqv? (string-length s4) 6)))
118
119(with-test-prefix "internal encoding"
120
121  (pass-if "�ltima"
122	   (string=? s1 (string-ints #xfa #x6c #x74 #x69 #x6d #x61)))
123
124  (pass-if "c�dula"
125	   (string=? s2 (string-ints #x63 #xe9 #x64 #x75 #x6c #x61)))
126
127  (pass-if "a�os"
128	   (string=? s3 (string-ints #x61 #xf1 #x6f #x73)))
129
130  (pass-if "�C�mo?"
131	   (string=? s4 (string-ints #xbf #x43 #xf3 #x6d #x6f #x3f))))
132
133(with-test-prefix "chars"
134
135  (pass-if "�ltima"
136	   (list= eqv? (string->list s1)
137		  (list #\� #\l #\t #\i #\m #\a)))
138
139  (pass-if "c�dula"
140	   (list= eqv? (string->list s2)
141		  (list #\c #\� #\d #\u #\l #\a)))
142
143  (pass-if "a�os"
144	   (list= eqv? (string->list s3)
145		  (list #\a #\� #\o #\s)))
146
147  (pass-if "�C�mo?"
148	   (list= eqv? (string->list s4)
149		  (list #\� #\C #\� #\m #\o #\?))))
150
151(with-test-prefix "symbols == strings"
152
153  (pass-if "�ltima"
154	   (eq? (string->symbol s1) '�ltima))
155
156  (pass-if "c�dula"
157	   (eq? (string->symbol s2) 'c�dula))
158
159  (pass-if "a�os"
160	   (eq? (string->symbol s3) 'a�os))
161
162  (pass-if "�C�mo?"
163	   (eq? (string->symbol s4) '�C�mo?)))
164
165(with-test-prefix "non-ascii variable names"
166
167  (pass-if "1"
168	   (let ((� 1)
169		 (� 2))
170	     (eqv? (+ � �) 3))))
171
172(with-test-prefix "output errors"
173
174  (pass-if-exception "char 256" exception:encoding-error
175		     (let ((pt (open-output-string)))
176		       (set-port-encoding! pt "ISO-8859-1")
177		       (set-port-conversion-strategy! pt 'error)
178		       (display (string-ints 256) pt))))
179