1 ;;;; strings.test --- test suite for Guile's string functions -*- mode: scheme; coding: iso-8859-7 -*-
3 ;;;; Copyright (C) 2009 Free Software Foundation, Inc.
5 ;;;; This program is free software; you can redistribute it and/or modify
6 ;;;; it under the terms of the GNU General Public License as published by
7 ;;;; the Free Software Foundation; either version 2, or (at your option)
8 ;;;; any later version.
10 ;;;; This program 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
13 ;;;; GNU General Public License for more details.
15 ;;;; You should have received a copy of the GNU General Public License
16 ;;;; along with this software; see the file COPYING. If not, write to
17 ;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
18 ;;;; Boston, MA 02110-1301 USA
20 (define-module (test-strings)
21 #:use-module (test-suite lib)
22 #:use-module (srfi srfi-1))
24 (define exception:conversion
25 (cons 'misc-error "^cannot convert to output locale"))
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)))
32 (if (defined? 'setlocale)
33 (set! oldlocale (setlocale LC_ALL "")))
34 (define ascii-a (integer->char 65)) ; LATIN CAPITAL LETTER A
35 (define a-acute (integer->char #x00c1)) ; LATIN CAPITAL LETTER A WITH ACUTE
36 (define alpha (integer->char #x03b1)) ; GREEK SMALL LETTER ALPHA
37 (define cherokee-a (integer->char #x13a0)) ; CHEROKEE LETTER A
39 (with-test-prefix "characters"
43 (pass-if "input alpha"
47 (let ((pt (open-output-string)))
48 (set-port-encoding! pt "ISO-8859-7")
49 (set-port-conversion-strategy! pt 'escape)
52 (get-output-string pt))))
54 (pass-if "display A acute"
55 (let ((pt (open-output-string)))
56 (set-port-encoding! pt "ISO-8859-7")
57 (set-port-conversion-strategy! pt 'escape)
60 (get-output-string pt))))
62 (pass-if "display alpha"
63 (let ((pt (open-output-string)))
64 (set-port-encoding! pt "ISO-8859-7")
65 (set-port-conversion-strategy! pt 'escape)
68 (get-output-string pt))))
70 (pass-if "display Cherokee A"
71 (let ((pt (open-output-string)))
72 (set-port-encoding! pt "ISO-8859-7")
73 (set-port-conversion-strategy! pt 'escape)
74 (display cherokee-a pt)
75 (string-ci=? "\\u13a0"
76 (get-output-string pt))))
79 (let ((pt (open-output-string)))
80 (set-port-encoding! pt "ISO-8859-7")
81 (set-port-conversion-strategy! pt 'escape)
84 (get-output-string pt))))
86 (pass-if "write alpha"
87 (let ((pt (open-output-string)))
88 (set-port-encoding! pt "ISO-8859-7")
89 (set-port-conversion-strategy! pt 'escape)
92 (get-output-string pt)))))
96 (define s3 "êñéôéêÞò")
99 (with-test-prefix "string length"
102 (eq? (string-length s1) 4))
105 (eq? (string-length s2) 3))
108 (eq? (string-length s3) 8))
111 (eq? (string-length s4) 3)))
113 (with-test-prefix "internal encoding"
116 (string=? s1 (string-ints #x03a0 #x03b5 #x03c1 #x03af)))
119 (string=? s2 (string-ints #x03c4 #x03b7 #x03c2)))
122 (string=? s3 (string-ints #x03ba #x03c1 #x03b9 #x03c4 #x03b9 #x03ba #x03ae #x03c2)))
125 (string=? s4 (string-ints #x03ba #x03b1 #x03b9))))
127 (with-test-prefix "chars"
130 (list= eqv? (string->list s1)
131 (list #\Ð #\å #\ñ #\ß)))
134 (list= eqv? (string->list s2)
138 (list= eqv? (string->list s3)
139 (list #\ê #\ñ #\é #\ô #\é #\ê #\Þ #\ò)))
142 (list= eqv? (string->list s4)
143 (list #\ê #\á #\é))))
145 (with-test-prefix "symbols == strings"
148 (eq? (string->symbol s1) 'Ðåñß))
151 (eq? (string->symbol s2) 'ôçò))
154 (eq? (string->symbol s3) 'êñéôéêÞò))
157 (eq? (string->symbol s4) 'êáé)))
159 (with-test-prefix "non-ascii variable names"
166 (with-test-prefix "output errors"
168 (pass-if-exception "char #x0400"
170 (let ((pt (open-output-string)))
171 (set-port-encoding! pt "ISO-8859-7")
172 (set-port-conversion-strategy! pt 'error)
173 (display (string-ints #x0400) pt))))
176 (if (defined? 'setlocale)
177 (setlocale LC_ALL oldlocale))