test-suite/tests/encoding-iso88597.test

   1 ;;;; encoding-iso88697.test --- test suite for Guile's string encodings    -*- mode: scheme; coding: iso-8859-7 -*-
   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 (when (defined? 'setlocale)
  28   (setlocale LC_ALL ""))
  29
  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 alpha"
  40     (char=? alpha #\á))
  41
  42   (pass-if "display A"
  43            (let ((pt (open-output-string)))
  44              (set-port-encoding! pt "ISO-8859-7")
  45              (set-port-conversion-strategy! pt 'escape)
  46              (display ascii-a pt)
  47              (string=? "A"
  48                        (get-output-string pt))))
  49
  50   (pass-if "display A acute"
  51            (let ((pt (open-output-string)))
  52              (set-port-encoding! pt "ISO-8859-7")
  53              (set-port-conversion-strategy! pt 'escape)
  54              (display a-acute pt)
  55              (string-ci=? "\\xc1"
  56                        (get-output-string pt))))
  57
  58   (pass-if "display alpha"
  59            (let ((pt (open-output-string)))
  60              (set-port-encoding! pt "ISO-8859-7")
  61              (set-port-conversion-strategy! pt 'escape)
  62              (display alpha pt)
  63              (string-ci=? "á"
  64                        (get-output-string pt))))
  65
  66   (pass-if "display Cherokee A"
  67            (let ((pt (open-output-string)))
  68              (set-port-encoding! pt "ISO-8859-7")
  69              (set-port-conversion-strategy! pt 'escape)
  70              (display cherokee-a pt)
  71              (string-ci=? "\\u13a0"
  72                        (get-output-string pt))))
  73
  74   (pass-if "write A"
  75            (let ((pt (open-output-string)))
  76              (set-port-encoding! pt "ISO-8859-7")
  77              (set-port-conversion-strategy! pt 'escape)
  78              (write ascii-a pt)
  79              (string=? "#\\A"
  80                        (get-output-string pt))))
  81
  82   (pass-if "write alpha"
  83            (let ((pt (open-output-string)))
  84              (set-port-encoding! pt "ISO-8859-7")
  85              (set-port-conversion-strategy! pt 'escape)
  86              (write alpha pt)
  87              (string=? "#\\á"
  88                        (get-output-string pt)))))
  89
  90 (define s1 "Ðåñß")
  91 (define s2 "ôçò")
  92 (define s3 "êñéôéêÞò")
  93 (define s4 "êáé")
  94
  95 (with-test-prefix "string length"
  96
  97   (pass-if "s1"
  98            (eqv? (string-length s1) 4))
  99
 100   (pass-if "s2"
 101            (eqv? (string-length s2) 3))
 102
 103   (pass-if "s3"
 104            (eqv? (string-length s3) 8))
 105
 106   (pass-if "s4"
 107            (eqv? (string-length s4) 3)))
 108
 109 (with-test-prefix "internal encoding"
 110
 111   (pass-if "s1"
 112            (string=? s1 (string-ints #x03a0 #x03b5 #x03c1 #x03af)))
 113
 114   (pass-if "s2"
 115            (string=? s2 (string-ints #x03c4 #x03b7 #x03c2)))
 116
 117   (pass-if "s3"
 118            (string=? s3 (string-ints #x03ba #x03c1 #x03b9 #x03c4 #x03b9 #x03ba #x03ae #x03c2)))
 119
 120   (pass-if "s4"
 121            (string=? s4 (string-ints #x03ba #x03b1 #x03b9))))
 122
 123 (with-test-prefix "chars"
 124
 125   (pass-if "s1"
 126            (list= eqv? (string->list s1)
 127                   (list #\Ð #\å #\ñ #\ß)))
 128
 129   (pass-if "s2"
 130            (list= eqv? (string->list s2)
 131                   (list #\ô #\ç #\ò)))
 132
 133   (pass-if "s3"
 134            (list= eqv? (string->list s3)
 135                   (list #\ê #\ñ #\é #\ô #\é #\ê #\Þ #\ò)))
 136
 137   (pass-if "s4"
 138            (list= eqv? (string->list s4)
 139                   (list #\ê #\á #\é))))
 140
 141 (with-test-prefix "symbols == strings"
 142
 143   (pass-if "Ðåñß"
 144            (eq? (string->symbol s1) 'Ðåñß))
 145
 146   (pass-if "ôçò"
 147            (eq? (string->symbol s2) 'ôçò))
 148
 149   (pass-if "êñéôéêÞò"
 150            (eq? (string->symbol s3) 'êñéôéêÞò))
 151
 152   (pass-if "êáé"
 153            (eq? (string->symbol s4) 'êáé)))
 154
 155 (with-test-prefix "non-ascii variable names"
 156
 157   (pass-if "1"
 158            (let ((á 1)
 159                  (ñ 2))
 160              (eqv? (+ á ñ) 3))))
 161
 162 (with-test-prefix "output errors"
 163
 164   (pass-if-exception "char #x0400"
 165                      exception:encoding-error
 166                      (let ((pt (open-output-string)))
 167                        (set-port-encoding! pt "ISO-8859-7")
 168                        (set-port-conversion-strategy! pt 'error)
 169                        (display (string-ints #x0400) pt))))