test-suite/tests/encoding-iso88591.test

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