test-suite/tests/encoding-escapes.test

   1 ;;;; encoding-escapes.test --- test suite for Guile's string encodings -*- mode: scheme; coding: utf-8 -*-
   2 ;;;;
   3 ;;;; Copyright (C) 2009, 2010, 2011 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 (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
  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) ""))))))
  95
  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))))))))
 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"
 143     (let ((pt (open-output-string)))
 144       (set-port-encoding! pt "ASCII")
 145       (set-port-conversion-strategy! pt 'escape)
 146       (display s4 pt)
 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)))))
 162
 163 (with-test-prefix "input escapes"
 164
 165   (pass-if "última"
 166     (with-locale "en_US.utf8"
 167                  (string=? "última"
 168                            (with-input-from-string "\"\\xfaltima\"" read))))
 169
 170   (pass-if "羅生門"
 171     (with-locale "en_US.utf8"
 172                  (string=? "羅生門"
 173                            (with-input-from-string
 174                                "\"\\u7F85\\u751F\\u9580\"" read)))))
 175