test/automated/fns-tests.el

   1 ;;; fns-tests.el --- tests for src/fns.c
   2
   3 ;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
   4
   5 ;; This file is part of GNU Emacs.
   6
   7 ;; This program is free software: you can redistribute it and/or
   8 ;; modify it under the terms of the GNU General Public License as
   9 ;; published by the Free Software Foundation, either version 3 of the
  10 ;; License, or (at your option) any later version.
  11 ;;
  12 ;; This program is distributed in the hope that it will be useful, but
  13 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15 ;; General Public License for more details.
  16 ;;
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with this program.  If not, see `http://www.gnu.org/licenses/'.
  19
  20 ;;; Commentary:
  21
  22 ;;; Code:
  23
  24 (require 'cl-lib)
  25 (eval-when-compile (require 'cl))
  26
  27 (ert-deftest fns-tests-reverse ()
  28   (should-error (reverse))
  29   (should-error (reverse 1))
  30   (should-error (reverse (make-char-table 'foo)))
  31   (should (equal [] (reverse [])))
  32   (should (equal [0] (reverse [0])))
  33   (should (equal [1 2 3 4] (reverse (reverse [1 2 3 4]))))
  34   (should (equal '(a b c d) (reverse (reverse '(a b c d)))))
  35   (should (equal "xyzzy" (reverse (reverse "xyzzy"))))
  36   (should (equal "こんにちは / ｺﾝﾆﾁﾊ" (reverse (reverse "こんにちは / ｺﾝﾆﾁﾊ")))))
  37
  38 (ert-deftest fns-tests-nreverse ()
  39   (should-error (nreverse))
  40   (should-error (nreverse 1))
  41   (should-error (nreverse (make-char-table 'foo)))
  42   (should (equal (nreverse "xyzzy") "yzzyx"))
  43   (let ((A []))
  44     (nreverse A)
  45     (should (equal A [])))
  46   (let ((A [0]))
  47     (nreverse A)
  48     (should (equal A [0])))
  49   (let ((A [1 2 3 4]))
  50     (nreverse A)
  51     (should (equal A [4 3 2 1])))
  52   (let ((A [1 2 3 4]))
  53     (nreverse A)
  54     (nreverse A)
  55     (should (equal A [1 2 3 4])))
  56   (let* ((A [1 2 3 4])
  57          (B (nreverse (nreverse A))))
  58     (should (equal A B))))
  59
  60 (ert-deftest fns-tests-reverse-bool-vector ()
  61   (let ((A (make-bool-vector 10 nil)))
  62     (dotimes (i 5) (aset A i t))
  63     (should (equal [nil nil nil nil nil t t t t t] (vconcat (reverse A))))
  64     (should (equal A (reverse (reverse A))))))
  65
  66 (ert-deftest fns-tests-nreverse-bool-vector ()
  67   (let ((A (make-bool-vector 10 nil)))
  68     (dotimes (i 5) (aset A i t))
  69     (nreverse A)
  70     (should (equal [nil nil nil nil nil t t t t t] (vconcat A)))
  71     (should (equal [t t t t t nil nil nil nil nil] (vconcat (nreverse A))))))
  72
  73 (ert-deftest fns-tests-compare-strings ()
  74   (should-error (compare-strings))
  75   (should-error (compare-strings "xyzzy" "xyzzy"))
  76   (should (= (compare-strings "xyzzy" 0 10 "zyxxy" 0 5) -1))
  77   (should-error (compare-strings "xyzzy" 0 5 "zyxxy" -1 2))
  78   (should-error (compare-strings "xyzzy" 'foo nil "zyxxy" 0 1))
  79   (should-error (compare-strings "xyzzy" 0 'foo "zyxxy" 2 3))
  80   (should-error (compare-strings "xyzzy" 0 2 "zyxxy" 'foo 3))
  81   (should-error (compare-strings "xyzzy" nil 3 "zyxxy" 4 'foo))
  82   (should (eq (compare-strings "" nil nil "" nil nil) t))
  83   (should (eq (compare-strings "" 0 0 "" 0 0) t))
  84   (should (eq (compare-strings "test" nil nil "test" nil nil) t))
  85   (should (eq (compare-strings "test" nil nil "test" nil nil t) t))
  86   (should (eq (compare-strings "test" nil nil "test" nil nil nil) t))
  87   (should (eq (compare-strings "Test" nil nil "test" nil nil t) t))
  88   (should (= (compare-strings "Test" nil nil "test" nil nil) -1))
  89   (should (= (compare-strings "Test" nil nil "test" nil nil) -1))
  90   (should (= (compare-strings "test" nil nil "Test" nil nil) 1))
  91   (should (= (compare-strings "foobaz" nil nil "barbaz" nil nil) 1))
  92   (should (= (compare-strings "barbaz" nil nil "foobar" nil nil) -1))
  93   (should (= (compare-strings "foobaz" nil nil "farbaz" nil nil) 2))
  94   (should (= (compare-strings "farbaz" nil nil "foobar" nil nil) -2))
  95   (should (eq (compare-strings "abcxyz" 0 2 "abcprq" 0 2) t))
  96   (should (eq (compare-strings "abcxyz" 0 -3 "abcprq" 0 -3) t))
  97   (should (= (compare-strings "abcxyz" 0 6 "abcprq" 0 6) 4))
  98   (should (= (compare-strings "abcprq" 0 6 "abcxyz" 0 6) -4))
  99   (should (eq (compare-strings "xyzzy" -3 4 "azza" -3 3) t))
 100   (should (eq (compare-strings "こんにちはｺﾝﾆﾁﾊ" nil nil "こんにちはｺﾝﾆﾁﾊ" nil nil) t))
 101   (should (= (compare-strings "んにちはｺﾝﾆﾁﾊこ" nil nil "こんにちはｺﾝﾆﾁﾊ" nil nil) 1))
 102   (should (= (compare-strings "こんにちはｺﾝﾆﾁﾊ" nil nil "んにちはｺﾝﾆﾁﾊこ" nil nil) -1)))
 103
 104 (defun fns-tests--collate-enabled-p ()
 105   "Check whether collation functions are enabled."
 106   (and
 107    ;; When there is no collation library, collation functions fall back
 108    ;; to their lexicographic counterparts.  We don't need to test then.
 109    (not (ignore-errors (string-collate-equalp "" "" t)))
 110    ;; We use a locale, which might not be installed.  Check it.
 111    (ignore-errors
 112      (string-collate-equalp
 113       "" "" (if (eq system-type 'windows-nt) "enu_USA" "en_US.UTF-8")))))
 114
 115 (ert-deftest fns-tests-collate-strings ()
 116   (skip-unless (fns-tests--collate-enabled-p))
 117
 118   (should (string-collate-equalp "xyzzy" "xyzzy"))
 119   (should-not (string-collate-equalp "xyzzy" "XYZZY"))
 120
 121   ;; In POSIX or C locales, collation order is lexicographic.
 122   (should (string-collate-lessp "XYZZY" "xyzzy" "POSIX"))
 123   ;; In a language specific locale, collation order is different.
 124   (should (string-collate-lessp
 125            "xyzzy" "XYZZY"
 126            (if (eq system-type 'windows-nt) "enu_USA" "en_US.UTF-8")))
 127
 128   ;; Ignore case.
 129   (should (string-collate-equalp "xyzzy" "XYZZY" nil t))
 130
 131   ;; Locale must be valid.
 132   (should-error (string-collate-equalp "xyzzy" "xyzzy" "en_DE.UTF-8")))
 133
 134 ;; There must be a check for valid codepoints.  (Check not implemented yet)
 135 ;  (should-error
 136 ;   (string-collate-equalp (string ?\x00110000) (string ?\x00110000)))
 137 ;; Invalid UTF-8 sequences shall be indicated.  How to create such strings?
 138
 139 (ert-deftest fns-tests-sort ()
 140   (should (equal (sort '(9 5 2 -1 5 3 8 7 4) (lambda (x y) (< x y)))
 141                  '(-1 2 3 4 5 5 7 8 9)))
 142   (should (equal (sort '(9 5 2 -1 5 3 8 7 4) (lambda (x y) (> x y)))
 143                  '(9 8 7 5 5 4 3 2 -1)))
 144   (should (equal (sort '[9 5 2 -1 5 3 8 7 4] (lambda (x y) (< x y)))
 145                  [-1 2 3 4 5 5 7 8 9]))
 146   (should (equal (sort '[9 5 2 -1 5 3 8 7 4] (lambda (x y) (> x y)))
 147                  [9 8 7 5 5 4 3 2 -1]))
 148   (should (equal
 149            (sort
 150             (vector
 151              '(8 . "xxx") '(9 . "aaa") '(8 . "bbb") '(9 . "zzz")
 152              '(9 . "ppp") '(8 . "ttt") '(8 . "eee") '(9 . "fff"))
 153             (lambda (x y) (< (car x) (car y))))
 154            [(8 . "xxx") (8 . "bbb") (8 . "ttt") (8 . "eee")
 155             (9 . "aaa") (9 . "zzz") (9 . "ppp") (9 . "fff")])))
 156
 157 (ert-deftest fns-tests-collate-sort ()
 158   (skip-unless (fns-tests--collate-enabled-p))
 159
 160   ;; Punctuation and whitespace characters are relevant for POSIX.
 161   (should
 162    (equal
 163     (sort '("11" "12" "1 1" "1 2" "1.1" "1.2")
 164           (lambda (a b) (string-collate-lessp a b "POSIX")))
 165     '("1 1" "1 2" "1.1" "1.2" "11" "12")))
 166   ;; Punctuation and whitespace characters are not taken into account
 167   ;; for collation in other locales.
 168   (should
 169    (equal
 170     (sort '("11" "12" "1 1" "1 2" "1.1" "1.2")
 171           (lambda (a b)
 172             (let ((w32-collate-ignore-punctuation t))
 173               (string-collate-lessp
 174                a b (if (eq system-type 'windows-nt) "enu_USA" "en_US.UTF-8")))))
 175     '("11" "1 1" "1.1" "12" "1 2" "1.2")))
 176
 177   ;; Diacritics are different letters for POSIX, they sort lexicographical.
 178   (should
 179    (equal
 180     (sort '("Ævar" "Agustín" "Adrian" "Eli")
 181           (lambda (a b) (string-collate-lessp a b "POSIX")))
 182     '("Adrian" "Agustín" "Eli" "Ævar")))
 183   ;; Diacritics are sorted between similar letters for other locales.
 184   (should
 185    (equal
 186     (sort '("Ævar" "Agustín" "Adrian" "Eli")
 187           (lambda (a b)
 188             (let ((w32-collate-ignore-punctuation t))
 189               (string-collate-lessp
 190                a b (if (eq system-type 'windows-nt) "enu_USA" "en_US.UTF-8")))))
 191     '("Adrian" "Ævar" "Agustín" "Eli"))))