test-suite/tests/coding.test

   1 ;;;; coding.test --- test suite for coding declarations. -*- mode: scheme -*-
   2 ;;;;
   3 ;;;; Copyright (C) 2011, 2013, 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-coding)
  20   #:use-module (test-suite lib))
  21
  22 (define (with-temp-file proc)
  23   (let* ((name (string-copy "/tmp/coding-test.XXXXXX"))
  24          (port (mkstemp! name)))
  25     (let ((res (with-throw-handler
  26                 #t
  27                 (lambda ()
  28                   (proc name port))
  29                 (lambda _
  30                   (delete-file name)))))
  31       (delete-file name)
  32       res)))
  33
  34 (define (scan-coding str)
  35   (with-temp-file
  36    (lambda (name port)
  37      (display str port)
  38      (close port)
  39      ;; We don't simply seek back and rescan, because the encoding scan
  40      ;; relies on the opportunistic filling of the input buffer, which
  41      ;; doesn't happen after a seek.
  42      (let* ((port (open-input-file name))
  43             (res (file-encoding port)))
  44        (close-port port)
  45        res))))
  46
  47 (with-test-prefix "block comments"
  48
  49   (pass-if-equal "first line"
  50       "ISO-8859-1"
  51     (scan-coding "#! coding: iso-8859-1 !#"))
  52
  53   (pass-if-equal "first line no whitespace"
  54       "ISO-8859-1"
  55     (scan-coding "#!coding:iso-8859-1!#"))
  56
  57   (pass-if-equal "second line"
  58       "ISO-8859-1"
  59     (scan-coding "#!  \n  coding: iso-8859-1  !#"))
  60
  61   (pass-if-equal "second line no whitespace"
  62       "ISO-8859-1"
  63     (scan-coding "#!\ncoding:iso-8859-1!#"))
  64
  65   (pass-if-equal "third line"
  66       "ISO-8859-1"
  67     (scan-coding "#! \n  coding: iso-8859-1  \n  !#"))
  68
  69   (pass-if-equal "third line no whitespace"
  70       "ISO-8859-1"
  71     (scan-coding "#!\ncoding:iso-8859-1\n!#")))
  72
  73 (with-test-prefix "line comment"
  74   (pass-if-equal "first line, no whitespace, no nl"
  75       "ISO-8859-1"
  76     (scan-coding ";coding:iso-8859-1"))
  77
  78   (pass-if-equal "first line, whitespace, no nl"
  79       "ISO-8859-1"
  80     (scan-coding "; coding: iso-8859-1 "))
  81
  82   (pass-if-equal "first line, no whitespace, nl"
  83       "ISO-8859-1"
  84     (scan-coding ";coding:iso-8859-1\n"))
  85
  86   (pass-if-equal "first line, whitespace, nl"
  87       "ISO-8859-1"
  88     (scan-coding "; coding: iso-8859-1 \n"))
  89
  90   (pass-if-equal "second line, no whitespace, no nl"
  91       "ISO-8859-1"
  92     (scan-coding "\n;coding:iso-8859-1"))
  93
  94   (pass-if-equal "second line, whitespace, no nl"
  95       "ISO-8859-1"
  96     (scan-coding "\n; coding: iso-8859-1 "))
  97
  98   (pass-if-equal "second line, no whitespace, nl"
  99       "ISO-8859-1"
 100     (scan-coding "\n;coding:iso-8859-1\n"))
 101
 102   (pass-if-equal "second line, whitespace, nl"
 103       "ISO-8859-1"
 104     (scan-coding "\n; coding: iso-8859-1 \n"))
 105
 106   (pass-if-equal "http://bugs.gnu.org/16463"
 107       ;; On Guile <= 2.0.9, this would return "ISO-8".
 108       "ISO-8859-1"
 109     (scan-coding (string-append (make-string 485 #\space)
 110                                 "; coding: ISO-8859-1"))))