test/src/fns-tests.el

   1 ;;; fns-tests.el --- tests for src/fns.c
   2
   3 ;; Copyright (C) 2014-2018 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 `https://www.gnu.org/licenses/'.
  19
  20 ;;; Commentary:
  21
  22 ;;; Code:
  23
  24 (require 'cl-lib)
  25
  26 ;; Test that equality predicates work correctly on NaNs when combined
  27 ;; with hash tables based on those predicates.  This was not the case
  28 ;; for eql in Emacs 26.
  29 (ert-deftest fns-tests-equality-nan ()
  30   (dolist (test (list #'eq #'eql #'equal))
  31     (let* ((h (make-hash-table :test test))
  32            (nan 0.0e+NaN)
  33            (-nan (- nan)))
  34       (puthash nan t h)
  35       (should (eq (funcall test nan -nan) (gethash -nan h))))))
  36
  37 (ert-deftest fns-tests-reverse ()
  38   (should-error (reverse))
  39   (should-error (reverse 1))
  40   (should-error (reverse (make-char-table 'foo)))
  41   (should (equal [] (reverse [])))
  42   (should (equal [0] (reverse [0])))
  43   (should (equal [1 2 3 4] (reverse (reverse [1 2 3 4]))))
  44   (should (equal '(a b c d) (reverse (reverse '(a b c d)))))
  45   (should (equal "xyzzy" (reverse (reverse "xyzzy"))))
  46   (should (equal "こんにちは / ｺﾝﾆﾁﾊ" (reverse (reverse "こんにちは / ｺﾝﾆﾁﾊ")))))
  47
  48 (ert-deftest fns-tests-nreverse ()
  49   (should-error (nreverse))
  50   (should-error (nreverse 1))
  51   (should-error (nreverse (make-char-table 'foo)))
  52   (should (equal (nreverse "xyzzy") "yzzyx"))
  53   (let ((A []))
  54     (nreverse A)
  55     (should (equal A [])))
  56   (let ((A [0]))
  57     (nreverse A)
  58     (should (equal A [0])))
  59   (let ((A [1 2 3 4]))
  60     (nreverse A)
  61     (should (equal A [4 3 2 1])))
  62   (let ((A [1 2 3 4]))
  63     (nreverse A)
  64     (nreverse A)
  65     (should (equal A [1 2 3 4])))
  66   (let* ((A [1 2 3 4])
  67          (B (nreverse (nreverse A))))
  68     (should (equal A B))))
  69
  70 (ert-deftest fns-tests-reverse-bool-vector ()
  71   (let ((A (make-bool-vector 10 nil)))
  72     (dotimes (i 5) (aset A i t))
  73     (should (equal [nil nil nil nil nil t t t t t] (vconcat (reverse A))))
  74     (should (equal A (reverse (reverse A))))))
  75
  76 (ert-deftest fns-tests-nreverse-bool-vector ()
  77   (let ((A (make-bool-vector 10 nil)))
  78     (dotimes (i 5) (aset A i t))
  79     (nreverse A)
  80     (should (equal [nil nil nil nil nil t t t t t] (vconcat A)))
  81     (should (equal [t t t t t nil nil nil nil nil] (vconcat (nreverse A))))))
  82
  83 (ert-deftest fns-tests-compare-strings ()
  84   (should-error (compare-strings))
  85   (should-error (compare-strings "xyzzy" "xyzzy"))
  86   (should (= (compare-strings "xyzzy" 0 10 "zyxxy" 0 5) -1))
  87   (should-error (compare-strings "xyzzy" 0 5 "zyxxy" -1 2))
  88   (should-error (compare-strings "xyzzy" 'foo nil "zyxxy" 0 1))
  89   (should-error (compare-strings "xyzzy" 0 'foo "zyxxy" 2 3))
  90   (should-error (compare-strings "xyzzy" 0 2 "zyxxy" 'foo 3))
  91   (should-error (compare-strings "xyzzy" nil 3 "zyxxy" 4 'foo))
  92   (should (eq (compare-strings "" nil nil "" nil nil) t))
  93   (should (eq (compare-strings "" 0 0 "" 0 0) t))
  94   (should (eq (compare-strings "test" nil nil "test" nil nil) t))
  95   (should (eq (compare-strings "test" nil nil "test" nil nil t) t))
  96   (should (eq (compare-strings "test" nil nil "test" nil nil nil) t))
  97   (should (eq (compare-strings "Test" nil nil "test" nil nil t) t))
  98   (should (= (compare-strings "Test" nil nil "test" nil nil) -1))
  99   (should (= (compare-strings "Test" nil nil "test" nil nil) -1))
 100   (should (= (compare-strings "test" nil nil "Test" nil nil) 1))
 101   (should (= (compare-strings "foobaz" nil nil "barbaz" nil nil) 1))
 102   (should (= (compare-strings "barbaz" nil nil "foobar" nil nil) -1))
 103   (should (= (compare-strings "foobaz" nil nil "farbaz" nil nil) 2))
 104   (should (= (compare-strings "farbaz" nil nil "foobar" nil nil) -2))
 105   (should (eq (compare-strings "abcxyz" 0 2 "abcprq" 0 2) t))
 106   (should (eq (compare-strings "abcxyz" 0 -3 "abcprq" 0 -3) t))
 107   (should (= (compare-strings "abcxyz" 0 6 "abcprq" 0 6) 4))
 108   (should (= (compare-strings "abcprq" 0 6 "abcxyz" 0 6) -4))
 109   (should (eq (compare-strings "xyzzy" -3 4 "azza" -3 3) t))
 110   (should (eq (compare-strings "こんにちはｺﾝﾆﾁﾊ" nil nil "こんにちはｺﾝﾆﾁﾊ" nil nil) t))
 111   (should (= (compare-strings "んにちはｺﾝﾆﾁﾊこ" nil nil "こんにちはｺﾝﾆﾁﾊ" nil nil) 1))
 112   (should (= (compare-strings "こんにちはｺﾝﾆﾁﾊ" nil nil "んにちはｺﾝﾆﾁﾊこ" nil nil) -1)))
 113
 114 (defun fns-tests--collate-enabled-p ()
 115   "Check whether collation functions are enabled."
 116   (and
 117    ;; When there is no collation library, collation functions fall back
 118    ;; to their lexicographic counterparts.  We don't need to test then.
 119    (not (ignore-errors (string-collate-equalp "" "" t)))
 120    ;; We use a locale, which might not be installed.  Check it.
 121    (ignore-errors
 122      (string-collate-equalp
 123       "" "" (if (eq system-type 'windows-nt) "enu_USA" "en_US.UTF-8")))))
 124
 125 (ert-deftest fns-tests-collate-strings ()
 126   (skip-unless (fns-tests--collate-enabled-p))
 127
 128   (should (string-collate-equalp "xyzzy" "xyzzy"))
 129   (should-not (string-collate-equalp "xyzzy" "XYZZY"))
 130
 131   ;; In POSIX or C locales, collation order is lexicographic.
 132   (should (string-collate-lessp "XYZZY" "xyzzy" "POSIX"))
 133   ;; In a language specific locale on MS-Windows, collation order is different.
 134   (when (eq system-type 'windows-nt)
 135     (should (string-collate-lessp "xyzzy" "XYZZY" "enu_USA")))
 136
 137   ;; Ignore case.
 138   (should (string-collate-equalp "xyzzy" "XYZZY" nil t))
 139
 140   ;; Locale must be valid.
 141   (should-error (string-collate-equalp "xyzzy" "xyzzy" "en_DE.UTF-8")))
 142
 143 ;; There must be a check for valid codepoints.  (Check not implemented yet)
 144 ;  (should-error
 145 ;   (string-collate-equalp (string ?\x00110000) (string ?\x00110000)))
 146 ;; Invalid UTF-8 sequences shall be indicated.  How to create such strings?
 147
 148 (ert-deftest fns-tests-sort ()
 149   (should (equal (sort '(9 5 2 -1 5 3 8 7 4) (lambda (x y) (< x y)))
 150                  '(-1 2 3 4 5 5 7 8 9)))
 151   (should (equal (sort '(9 5 2 -1 5 3 8 7 4) (lambda (x y) (> x y)))
 152                  '(9 8 7 5 5 4 3 2 -1)))
 153   (should (equal (sort '[9 5 2 -1 5 3 8 7 4] (lambda (x y) (< x y)))
 154                  [-1 2 3 4 5 5 7 8 9]))
 155   (should (equal (sort '[9 5 2 -1 5 3 8 7 4] (lambda (x y) (> x y)))
 156                  [9 8 7 5 5 4 3 2 -1]))
 157   (should (equal
 158            (sort
 159             (vector
 160              '(8 . "xxx") '(9 . "aaa") '(8 . "bbb") '(9 . "zzz")
 161              '(9 . "ppp") '(8 . "ttt") '(8 . "eee") '(9 . "fff"))
 162             (lambda (x y) (< (car x) (car y))))
 163            [(8 . "xxx") (8 . "bbb") (8 . "ttt") (8 . "eee")
 164             (9 . "aaa") (9 . "zzz") (9 . "ppp") (9 . "fff")])))
 165
 166 (ert-deftest fns-tests-collate-sort ()
 167   (skip-unless (fns-tests--collate-enabled-p))
 168
 169   ;; Punctuation and whitespace characters are relevant for POSIX.
 170   (should
 171    (equal
 172     (sort '("11" "12" "1 1" "1 2" "1.1" "1.2")
 173           (lambda (a b) (string-collate-lessp a b "POSIX")))
 174     '("1 1" "1 2" "1.1" "1.2" "11" "12")))
 175   ;; Punctuation and whitespace characters are not taken into account
 176   ;; for collation in other locales, on MS-Windows systems.
 177   (when (eq system-type 'windows-nt)
 178     (should
 179      (equal
 180       (sort '("11" "12" "1 1" "1 2" "1.1" "1.2")
 181             (lambda (a b)
 182               (let ((w32-collate-ignore-punctuation t))
 183                 (string-collate-lessp
 184                  a b "enu_USA"))))
 185       '("11" "1 1" "1.1" "12" "1 2" "1.2"))))
 186
 187   ;; Diacritics are different letters for POSIX, they sort lexicographical.
 188   (should
 189    (equal
 190     (sort '("Ævar" "Agustín" "Adrian" "Eli")
 191           (lambda (a b) (string-collate-lessp a b "POSIX")))
 192     '("Adrian" "Agustín" "Eli" "Ævar")))
 193   ;; Diacritics are sorted between similar letters for other locales,
 194   ;; on MS-Windows systems.
 195   (when (eq system-type 'windows-nt)
 196     (should
 197      (equal
 198       (sort '("Ævar" "Agustín" "Adrian" "Eli")
 199             (lambda (a b)
 200               (let ((w32-collate-ignore-punctuation t))
 201                 (string-collate-lessp
 202                  a b "enu_USA"))))
 203       '("Adrian" "Ævar" "Agustín" "Eli")))))
 204
 205 (ert-deftest fns-tests-string-version-lessp ()
 206   (should (string-version-lessp "foo2.png" "foo12.png"))
 207   (should (not (string-version-lessp "foo12.png" "foo2.png")))
 208   (should (string-version-lessp "foo12.png" "foo20000.png"))
 209   (should (not (string-version-lessp "foo20000.png" "foo12.png")))
 210   (should (string-version-lessp "foo.png" "foo2.png"))
 211   (should (not (string-version-lessp "foo2.png" "foo.png")))
 212   (should (equal (sort '("foo12.png" "foo2.png" "foo1.png")
 213                        'string-version-lessp)
 214                  '("foo1.png" "foo2.png" "foo12.png")))
 215   (should (string-version-lessp "foo2" "foo1234"))
 216   (should (not (string-version-lessp "foo1234" "foo2")))
 217   (should (string-version-lessp "foo.png" "foo2"))
 218   (should (string-version-lessp "foo1.25.5.png" "foo1.125.5"))
 219   (should (string-version-lessp "2" "1245"))
 220   (should (not (string-version-lessp "1245" "2"))))
 221
 222 (ert-deftest fns-tests-func-arity ()
 223   (should (equal (func-arity 'car) '(1 . 1)))
 224   (should (equal (func-arity 'caar) '(1 . 1)))
 225   (should (equal (func-arity 'format) '(1 . many)))
 226   (require 'info)
 227   (should (equal (func-arity 'Info-goto-node) '(1 . 3)))
 228   (should (equal (func-arity (lambda (&rest x))) '(0 . many)))
 229   (should (equal (func-arity (eval (lambda (x &optional y)) nil)) '(1 . 2)))
 230   (should (equal (func-arity (eval (lambda (x &optional y)) t)) '(1 . 2)))
 231   (should (equal (func-arity 'let) '(1 . unevalled))))
 232
 233 (ert-deftest fns-tests-hash-buffer ()
 234   (should (equal (sha1 "foo") "0beec7b5ea3f0fdbc95d0dd47f3c5bc275da8a33"))
 235   (should (equal (with-temp-buffer
 236                    (insert "foo")
 237                    (buffer-hash))
 238                  (sha1 "foo")))
 239   ;; This tests whether the presence of a gap in the middle of the
 240   ;; buffer is handled correctly.
 241   (should (equal (with-temp-buffer
 242                    (insert "foo")
 243                    (goto-char 2)
 244                    (insert " ")
 245                    (backward-delete-char 1)
 246                    (buffer-hash))
 247                  (sha1 "foo"))))
 248
 249 (ert-deftest fns-tests-mapcan ()
 250   (should-error (mapcan))
 251   (should-error (mapcan #'identity))
 252   (should-error (mapcan #'identity (make-char-table 'foo)))
 253   (should (equal (mapcan #'list '(1 2 3)) '(1 2 3)))
 254   ;; `mapcan' is destructive
 255   (let ((data '((foo) (bar))))
 256     (should (equal (mapcan #'identity data) '(foo bar)))
 257     (should (equal data                     '((foo bar) (bar))))))
 258
 259 ;; Test handling of cyclic and dotted lists.
 260
 261 (defun cyc1 (a)
 262   (let ((ls (make-list 10 a)))
 263     (nconc ls ls)
 264     ls))
 265
 266 (defun cyc2 (a b)
 267   (let ((ls1 (make-list 10 a))
 268         (ls2 (make-list 1000 b)))
 269     (nconc ls2 ls2)
 270     (nconc ls1 ls2)
 271     ls1))
 272
 273 (defun dot1 (a)
 274   (let ((ls (make-list 10 a)))
 275     (nconc ls 'tail)
 276     ls))
 277
 278 (defun dot2 (a b)
 279   (let ((ls1 (make-list 10 a))
 280         (ls2 (make-list 10 b)))
 281     (nconc ls1 ls2)
 282     (nconc ls2 'tail)
 283     ls1))
 284
 285 (ert-deftest test-cycle-length ()
 286   (should-error (length (cyc1 1)) :type 'circular-list)
 287   (should-error (length (cyc2 1 2)) :type 'circular-list)
 288   (should-error (length (dot1 1)) :type 'wrong-type-argument)
 289   (should-error (length (dot2 1 2)) :type 'wrong-type-argument))
 290
 291 (ert-deftest test-cycle-safe-length ()
 292   (should (<= 10 (safe-length (cyc1 1))))
 293   (should (<= 1010 (safe-length (cyc2 1 2))))
 294   (should (= 10 (safe-length (dot1 1))))
 295   (should (= 20 (safe-length (dot2 1 2)))))
 296
 297 (ert-deftest test-cycle-member ()
 298   (let ((c1 (cyc1 1))
 299         (c2 (cyc2 1 2))
 300         (d1 (dot1 1))
 301         (d2 (dot2 1 2)))
 302     (should (member 1 c1))
 303     (should (member 1 c2))
 304     (should (member 1 d1))
 305     (should (member 1 d2))
 306     (should-error (member 2 c1) :type 'circular-list)
 307     (should (member 2 c2))
 308     (should-error (member 2 d1) :type 'wrong-type-argument)
 309     (should (member 2 d2))
 310     (should-error (member 3 c1) :type 'circular-list)
 311     (should-error (member 3 c2) :type 'circular-list)
 312     (should-error (member 3 d1) :type 'wrong-type-argument)
 313     (should-error (member 3 d2) :type 'wrong-type-argument)))
 314
 315 (ert-deftest test-cycle-memq ()
 316   (let ((c1 (cyc1 1))
 317         (c2 (cyc2 1 2))
 318         (d1 (dot1 1))
 319         (d2 (dot2 1 2)))
 320     (should (memq 1 c1))
 321     (should (memq 1 c2))
 322     (should (memq 1 d1))
 323     (should (memq 1 d2))
 324     (should-error (memq 2 c1) :type 'circular-list)
 325     (should (memq 2 c2))
 326     (should-error (memq 2 d1) :type 'wrong-type-argument)
 327     (should (memq 2 d2))
 328     (should-error (memq 3 c1) :type 'circular-list)
 329     (should-error (memq 3 c2) :type 'circular-list)
 330     (should-error (memq 3 d1) :type 'wrong-type-argument)
 331     (should-error (memq 3 d2) :type 'wrong-type-argument)))
 332
 333 (ert-deftest test-cycle-memql ()
 334   (let ((c1 (cyc1 1))
 335         (c2 (cyc2 1 2))
 336         (d1 (dot1 1))
 337         (d2 (dot2 1 2)))
 338     (should (memql 1 c1))
 339     (should (memql 1 c2))
 340     (should (memql 1 d1))
 341     (should (memql 1 d2))
 342     (should-error (memql 2 c1) :type 'circular-list)
 343     (should (memql 2 c2))
 344     (should-error (memql 2 d1) :type 'wrong-type-argument)
 345     (should (memql 2 d2))
 346     (should-error (memql 3 c1) :type 'circular-list)
 347     (should-error (memql 3 c2) :type 'circular-list)
 348     (should-error (memql 3 d1) :type 'wrong-type-argument)
 349     (should-error (memql 3 d2) :type 'wrong-type-argument)))
 350
 351 (ert-deftest test-cycle-assq ()
 352   (let ((c1 (cyc1 '(1)))
 353         (c2 (cyc2 '(1) '(2)))
 354         (d1 (dot1 '(1)))
 355         (d2 (dot2 '(1) '(2))))
 356     (should (assq 1 c1))
 357     (should (assq 1 c2))
 358     (should (assq 1 d1))
 359     (should (assq 1 d2))
 360     (should-error (assq 2 c1) :type 'circular-list)
 361     (should (assq 2 c2))
 362     (should-error (assq 2 d1) :type 'wrong-type-argument)
 363     (should (assq 2 d2))
 364     (should-error (assq 3 c1) :type 'circular-list)
 365     (should-error (assq 3 c2) :type 'circular-list)
 366     (should-error (assq 3 d1) :type 'wrong-type-argument)
 367     (should-error (assq 3 d2) :type 'wrong-type-argument)))
 368
 369 (ert-deftest test-cycle-assoc ()
 370   (let ((c1 (cyc1 '(1)))
 371         (c2 (cyc2 '(1) '(2)))
 372         (d1 (dot1 '(1)))
 373         (d2 (dot2 '(1) '(2))))
 374     (should (assoc 1 c1))
 375     (should (assoc 1 c2))
 376     (should (assoc 1 d1))
 377     (should (assoc 1 d2))
 378     (should-error (assoc 2 c1) :type 'circular-list)
 379     (should (assoc 2 c2))
 380     (should-error (assoc 2 d1) :type 'wrong-type-argument)
 381     (should (assoc 2 d2))
 382     (should-error (assoc 3 c1) :type 'circular-list)
 383     (should-error (assoc 3 c2) :type 'circular-list)
 384     (should-error (assoc 3 d1) :type 'wrong-type-argument)
 385     (should-error (assoc 3 d2) :type 'wrong-type-argument)))
 386
 387 (ert-deftest test-assoc-testfn ()
 388   (let ((alist '(("a" . 1) ("b" . 2))))
 389     (should-not (assoc "a" alist #'ignore))
 390     (should (eq (assoc "b" alist #'string-equal) (cadr alist)))
 391     (should-not (assoc "b" alist #'eq))))
 392
 393 (ert-deftest test-cycle-rassq ()
 394   (let ((c1 (cyc1 '(0 . 1)))
 395         (c2 (cyc2 '(0 . 1) '(0 . 2)))
 396         (d1 (dot1 '(0 . 1)))
 397         (d2 (dot2 '(0 . 1) '(0 . 2))))
 398     (should (rassq 1 c1))
 399     (should (rassq 1 c2))
 400     (should (rassq 1 d1))
 401     (should (rassq 1 d2))
 402     (should-error (rassq 2 c1) :type 'circular-list)
 403     (should (rassq 2 c2))
 404     (should-error (rassq 2 d1) :type 'wrong-type-argument)
 405     (should (rassq 2 d2))
 406     (should-error (rassq 3 c1) :type 'circular-list)
 407     (should-error (rassq 3 c2) :type 'circular-list)
 408     (should-error (rassq 3 d1) :type 'wrong-type-argument)
 409     (should-error (rassq 3 d2) :type 'wrong-type-argument)))
 410
 411 (ert-deftest test-cycle-rassoc ()
 412   (let ((c1 (cyc1 '(0 . 1)))
 413         (c2 (cyc2 '(0 . 1) '(0 . 2)))
 414         (d1 (dot1 '(0 . 1)))
 415         (d2 (dot2 '(0 . 1) '(0 . 2))))
 416     (should (rassoc 1 c1))
 417     (should (rassoc 1 c2))
 418     (should (rassoc 1 d1))
 419     (should (rassoc 1 d2))
 420     (should-error (rassoc 2 c1) :type 'circular-list)
 421     (should (rassoc 2 c2))
 422     (should-error (rassoc 2 d1) :type 'wrong-type-argument)
 423     (should (rassoc 2 d2))
 424     (should-error (rassoc 3 c1) :type 'circular-list)
 425     (should-error (rassoc 3 c2) :type 'circular-list)
 426     (should-error (rassoc 3 d1) :type 'wrong-type-argument)
 427     (should-error (rassoc 3 d2) :type 'wrong-type-argument)))
 428
 429 (ert-deftest test-cycle-delq ()
 430   (should-error (delq 1 (cyc1 1)) :type 'circular-list)
 431   (should-error (delq 1 (cyc2 1 2)) :type 'circular-list)
 432   (should-error (delq 1 (dot1 1)) :type 'wrong-type-argument)
 433   (should-error (delq 1 (dot2 1 2)) :type 'wrong-type-argument)
 434   (should-error (delq 2 (cyc1 1)) :type 'circular-list)
 435   (should-error (delq 2 (cyc2 1 2)) :type 'circular-list)
 436   (should-error (delq 2 (dot1 1)) :type 'wrong-type-argument)
 437   (should-error (delq 2 (dot2 1 2)) :type 'wrong-type-argument)
 438   (should-error (delq 3 (cyc1 1)) :type 'circular-list)
 439   (should-error (delq 3 (cyc2 1 2)) :type 'circular-list)
 440   (should-error (delq 3 (dot1 1)) :type 'wrong-type-argument)
 441   (should-error (delq 3 (dot2 1 2)) :type 'wrong-type-argument))
 442
 443 (ert-deftest test-cycle-delete ()
 444   (should-error (delete 1 (cyc1 1)) :type 'circular-list)
 445   (should-error (delete 1 (cyc2 1 2)) :type 'circular-list)
 446   (should-error (delete 1 (dot1 1)) :type 'wrong-type-argument)
 447   (should-error (delete 1 (dot2 1 2)) :type 'wrong-type-argument)
 448   (should-error (delete 2 (cyc1 1)) :type 'circular-list)
 449   (should-error (delete 2 (cyc2 1 2)) :type 'circular-list)
 450   (should-error (delete 2 (dot1 1)) :type 'wrong-type-argument)
 451   (should-error (delete 2 (dot2 1 2)) :type 'wrong-type-argument)
 452   (should-error (delete 3 (cyc1 1)) :type 'circular-list)
 453   (should-error (delete 3 (cyc2 1 2)) :type 'circular-list)
 454   (should-error (delete 3 (dot1 1)) :type 'wrong-type-argument)
 455   (should-error (delete 3 (dot2 1 2)) :type 'wrong-type-argument))
 456
 457 (ert-deftest test-cycle-reverse ()
 458   (should-error (reverse (cyc1 1)) :type 'circular-list)
 459   (should-error (reverse (cyc2 1 2)) :type 'circular-list)
 460   (should-error (reverse (dot1 1)) :type 'wrong-type-argument)
 461   (should-error (reverse (dot2 1 2)) :type 'wrong-type-argument))
 462
 463 (ert-deftest test-cycle-plist-get ()
 464   (let ((c1 (cyc1 1))
 465         (c2 (cyc2 1 2))
 466         (d1 (dot1 1))
 467         (d2 (dot2 1 2)))
 468     (should (plist-get c1 1))
 469     (should (plist-get c2 1))
 470     (should (plist-get d1 1))
 471     (should (plist-get d2 1))
 472     (should-not (plist-get c1 2))
 473     (should (plist-get c2 2))
 474     (should-not (plist-get d1 2))
 475     (should (plist-get d2 2))
 476     (should-not (plist-get c1 3))
 477     (should-not (plist-get c2 3))
 478     (should-not (plist-get d1 3))
 479     (should-not (plist-get d2 3))))
 480
 481 (ert-deftest test-cycle-lax-plist-get ()
 482   (let ((c1 (cyc1 1))
 483         (c2 (cyc2 1 2))
 484         (d1 (dot1 1))
 485         (d2 (dot2 1 2)))
 486     (should (lax-plist-get c1 1))
 487     (should (lax-plist-get c2 1))
 488     (should (lax-plist-get d1 1))
 489     (should (lax-plist-get d2 1))
 490     (should-error (lax-plist-get c1 2) :type 'circular-list)
 491     (should (lax-plist-get c2 2))
 492     (should-error (lax-plist-get d1 2) :type 'wrong-type-argument)
 493     (should (lax-plist-get d2 2))
 494     (should-error (lax-plist-get c1 3) :type 'circular-list)
 495     (should-error (lax-plist-get c2 3) :type 'circular-list)
 496     (should-error (lax-plist-get d1 3) :type 'wrong-type-argument)
 497     (should-error (lax-plist-get d2 3) :type 'wrong-type-argument)))
 498
 499 (ert-deftest test-cycle-plist-member ()
 500   (let ((c1 (cyc1 1))
 501         (c2 (cyc2 1 2))
 502         (d1 (dot1 1))
 503         (d2 (dot2 1 2)))
 504     (should (plist-member c1 1))
 505     (should (plist-member c2 1))
 506     (should (plist-member d1 1))
 507     (should (plist-member d2 1))
 508     (should-error (plist-member c1 2) :type 'circular-list)
 509     (should (plist-member c2 2))
 510     (should-error (plist-member d1 2) :type 'wrong-type-argument)
 511     (should (plist-member d2 2))
 512     (should-error (plist-member c1 3) :type 'circular-list)
 513     (should-error (plist-member c2 3) :type 'circular-list)
 514     (should-error (plist-member d1 3) :type 'wrong-type-argument)
 515     (should-error (plist-member d2 3) :type 'wrong-type-argument)))
 516
 517 (ert-deftest test-cycle-plist-put ()
 518   (let ((c1 (cyc1 1))
 519         (c2 (cyc2 1 2))
 520         (d1 (dot1 1))
 521         (d2 (dot2 1 2)))
 522     (should (plist-put c1 1 1))
 523     (should (plist-put c2 1 1))
 524     (should (plist-put d1 1 1))
 525     (should (plist-put d2 1 1))
 526     (should-error (plist-put c1 2 2) :type 'circular-list)
 527     (should (plist-put c2 2 2))
 528     (should-error (plist-put d1 2 2) :type 'wrong-type-argument)
 529     (should (plist-put d2 2 2))
 530     (should-error (plist-put c1 3 3) :type 'circular-list)
 531     (should-error (plist-put c2 3 3) :type 'circular-list)
 532     (should-error (plist-put d1 3 3) :type 'wrong-type-argument)
 533     (should-error (plist-put d2 3 3) :type 'wrong-type-argument)))
 534
 535 (ert-deftest test-cycle-lax-plist-put ()
 536   (let ((c1 (cyc1 1))
 537         (c2 (cyc2 1 2))
 538         (d1 (dot1 1))
 539         (d2 (dot2 1 2)))
 540     (should (lax-plist-put c1 1 1))
 541     (should (lax-plist-put c2 1 1))
 542     (should (lax-plist-put d1 1 1))
 543     (should (lax-plist-put d2 1 1))
 544     (should-error (lax-plist-put c1 2 2) :type 'circular-list)
 545     (should (lax-plist-put c2 2 2))
 546     (should-error (lax-plist-put d1 2 2) :type 'wrong-type-argument)
 547     (should (lax-plist-put d2 2 2))
 548     (should-error (lax-plist-put c1 3 3) :type 'circular-list)
 549     (should-error (lax-plist-put c2 3 3) :type 'circular-list)
 550     (should-error (lax-plist-put d1 3 3) :type 'wrong-type-argument)
 551     (should-error (lax-plist-put d2 3 3) :type 'wrong-type-argument)))
 552
 553 (ert-deftest test-cycle-equal ()
 554   (should-error (equal (cyc1 1) (cyc1 1)))
 555   (should-error (equal (cyc2 1 2) (cyc2 1 2))))
 556
 557 (ert-deftest test-cycle-nconc ()
 558   (should-error (nconc (cyc1 1) 'tail) :type 'circular-list)
 559   (should-error (nconc (cyc2 1 2) 'tail) :type 'circular-list))
 560
 561 (ert-deftest plist-get/odd-number-of-elements ()
 562   "Test that `plist-get' doesn't signal an error on degenerate plists."
 563   (should-not (plist-get '(:foo 1 :bar) :bar)))
 564
 565 (ert-deftest lax-plist-get/odd-number-of-elements ()
 566   "Check for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27726."
 567   (should (equal (should-error (lax-plist-get '(:foo 1 :bar) :bar)
 568                                :type 'wrong-type-argument)
 569                  '(wrong-type-argument plistp (:foo 1 :bar)))))
 570
 571 (ert-deftest plist-put/odd-number-of-elements ()
 572   "Check for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27726."
 573   (should (equal (should-error (plist-put '(:foo 1 :bar) :zot 2)
 574                                :type 'wrong-type-argument)
 575                  '(wrong-type-argument plistp (:foo 1 :bar)))))
 576
 577 (ert-deftest lax-plist-put/odd-number-of-elements ()
 578   "Check for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27726."
 579   (should (equal (should-error (lax-plist-put '(:foo 1 :bar) :zot 2)
 580                                :type 'wrong-type-argument)
 581                  '(wrong-type-argument plistp (:foo 1 :bar)))))
 582
 583 (ert-deftest plist-member/improper-list ()
 584   "Check for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27726."
 585   (should (equal (should-error (plist-member '(:foo 1 . :bar) :qux)
 586                                :type 'wrong-type-argument)
 587                  '(wrong-type-argument plistp (:foo 1 . :bar)))))
 588
 589 (ert-deftest test-string-distance ()
 590   "Test `string-distance' behavior."
 591   ;; ASCII characters are always fine
 592   (should (equal 1 (string-distance "heelo" "hello")))
 593   (should (equal 2 (string-distance "aeelo" "hello")))
 594   (should (equal 0 (string-distance "ab" "ab" t)))
 595   (should (equal 1 (string-distance "ab" "abc" t)))
 596
 597   ;; string containing hanzi character, compare by byte
 598   (should (equal 6 (string-distance "ab" "ab我她" t)))
 599   (should (equal 3 (string-distance "ab" "a我b" t)))
 600   (should (equal 3 (string-distance "我" "她" t)))
 601
 602   ;; string containing hanzi character, compare by character
 603   (should (equal 2 (string-distance "ab" "ab我她")))
 604   (should (equal 1 (string-distance "ab" "a我b")))
 605   (should (equal 1 (string-distance "我" "她"))))
 606
 607 (provide 'fns-tests)