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