procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add cyclic-list tests

Browse source 
* test/manual/cycle-tests.el: New file (Bug#25606).
This commit is contained in:
Paul Eggert 2017-02-05 13:25:37 -08:00 • committed by Paul Eggert
parent b491322ed0
commit c3ee4d2860
1 changed files with 314 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

314
test/manual/cycle-tests.el Normal file
View file

@ -0,0 +1,314 @@
;;; Test handling of cyclic and dotted lists -*- lexical-binding: t; -*-
;; Copyright 2017 Free Software Foundation, Inc.
;; Written by Paul Eggert
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
(require 'ert)
(defun cyc1 (a)
(let ((ls (make-list 10 a)))
(nconc ls ls)
ls))
(defun cyc2 (a b)
(let ((ls1 (make-list 10 a))
(ls2 (make-list 1000 b)))
(nconc ls2 ls2)
(nconc ls1 ls2)
ls1))
(defun dot1 (a)
(let ((ls (make-list 10 a)))
(nconc ls 'tail)
ls))
(defun dot2 (a b)
(let ((ls1 (make-list 10 a))
(ls2 (make-list 10 b)))
(nconc ls1 ls2)
(nconc ls2 'tail)
ls1))
(ert-deftest test-cycle-length ()
(should-error (length (cyc1 1)) :type 'circular-list)
(should-error (length (cyc2 1 2)) :type 'circular-list)
(should-error (length (dot1 1)) :type 'wrong-type-argument)
(should-error (length (dot2 1 2)) :type 'wrong-type-argument))
(ert-deftest test-cycle-safe-length ()
(should (<= 10 (safe-length (cyc1 1))))
(should (<= 1010 (safe-length (cyc2 1 2))))
(should (= 10 (safe-length (dot1 1))))
(should (= 20 (safe-length (dot2 1 2)))))
(ert-deftest test-cycle-member ()
(let ((c1 (cyc1 1))
(c2 (cyc2 1 2))
(d1 (dot1 1))
(d2 (dot2 1 2)))
(should (member 1 c1))
(should (member 1 c2))
(should (member 1 d1))
(should (member 1 d2))
(should-error (member 2 c1) :type 'circular-list)
(should (member 2 c2))
(should-error (member 2 d1) :type 'wrong-type-argument)
(should (member 2 d2))
(should-error (member 3 c1) :type 'circular-list)
(should-error (member 3 c2) :type 'circular-list)
(should-error (member 3 d1) :type 'wrong-type-argument)
(should-error (member 3 d2) :type 'wrong-type-argument)))
(ert-deftest test-cycle-memq ()
(let ((c1 (cyc1 1))
(c2 (cyc2 1 2))
(d1 (dot1 1))
(d2 (dot2 1 2)))
(should (memq 1 c1))
(should (memq 1 c2))
(should (memq 1 d1))
(should (memq 1 d2))
(should-error (memq 2 c1) :type 'circular-list)
(should (memq 2 c2))
(should-error (memq 2 d1) :type 'wrong-type-argument)
(should (memq 2 d2))
(should-error (memq 3 c1) :type 'circular-list)
(should-error (memq 3 c2) :type 'circular-list)
(should-error (memq 3 d1) :type 'wrong-type-argument)
(should-error (memq 3 d2) :type 'wrong-type-argument)))
(ert-deftest test-cycle-memql ()
(let ((c1 (cyc1 1))
(c2 (cyc2 1 2))
(d1 (dot1 1))
(d2 (dot2 1 2)))
(should (memql 1 c1))
(should (memql 1 c2))
(should (memql 1 d1))
(should (memql 1 d2))
(should-error (memql 2 c1) :type 'circular-list)
(should (memql 2 c2))
(should-error (memql 2 d1) :type 'wrong-type-argument)
(should (memql 2 d2))
(should-error (memql 3 c1) :type 'circular-list)
(should-error (memql 3 c2) :type 'circular-list)
(should-error (memql 3 d1) :type 'wrong-type-argument)
(should-error (memql 3 d2) :type 'wrong-type-argument)))
(ert-deftest test-cycle-assq ()
(let ((c1 (cyc1 '(1)))
(c2 (cyc2 '(1) '(2)))
(d1 (dot1 '(1)))
(d2 (dot2 '(1) '(2))))
(should (assq 1 c1))
(should (assq 1 c2))
(should (assq 1 d1))
(should (assq 1 d2))
(should-error (assq 2 c1) :type 'circular-list)
(should (assq 2 c2))
(should-error (assq 2 d1) :type 'wrong-type-argument)
(should (assq 2 d2))
(should-error (assq 3 c1) :type 'circular-list)
(should-error (assq 3 c2) :type 'circular-list)
(should-error (assq 3 d1) :type 'wrong-type-argument)
(should-error (assq 3 d2) :type 'wrong-type-argument)))
(ert-deftest test-cycle-assoc ()
(let ((c1 (cyc1 '(1)))
(c2 (cyc2 '(1) '(2)))
(d1 (dot1 '(1)))
(d2 (dot2 '(1) '(2))))
(should (assoc 1 c1))
(should (assoc 1 c2))
(should (assoc 1 d1))
(should (assoc 1 d2))
(should-error (assoc 2 c1) :type 'circular-list)
(should (assoc 2 c2))
(should-error (assoc 2 d1) :type 'wrong-type-argument)
(should (assoc 2 d2))
(should-error (assoc 3 c1) :type 'circular-list)
(should-error (assoc 3 c2) :type 'circular-list)
(should-error (assoc 3 d1) :type 'wrong-type-argument)
(should-error (assoc 3 d2) :type 'wrong-type-argument)))
(ert-deftest test-cycle-rassq ()
(let ((c1 (cyc1 '(0 . 1)))
(c2 (cyc2 '(0 . 1) '(0 . 2)))
(d1 (dot1 '(0 . 1)))
(d2 (dot2 '(0 . 1) '(0 . 2))))
(should (rassq 1 c1))
(should (rassq 1 c2))
(should (rassq 1 d1))
(should (rassq 1 d2))
(should-error (rassq 2 c1) :type 'circular-list)
(should (rassq 2 c2))
(should-error (rassq 2 d1) :type 'wrong-type-argument)
(should (rassq 2 d2))
(should-error (rassq 3 c1) :type 'circular-list)
(should-error (rassq 3 c2) :type 'circular-list)
(should-error (rassq 3 d1) :type 'wrong-type-argument)
(should-error (rassq 3 d2) :type 'wrong-type-argument)))
(ert-deftest test-cycle-rassoc ()
(let ((c1 (cyc1 '(0 . 1)))
(c2 (cyc2 '(0 . 1) '(0 . 2)))
(d1 (dot1 '(0 . 1)))
(d2 (dot2 '(0 . 1) '(0 . 2))))
(should (rassoc 1 c1))
(should (rassoc 1 c2))
(should (rassoc 1 d1))
(should (rassoc 1 d2))
(should-error (rassoc 2 c1) :type 'circular-list)
(should (rassoc 2 c2))
(should-error (rassoc 2 d1) :type 'wrong-type-argument)
(should (rassoc 2 d2))
(should-error (rassoc 3 c1) :type 'circular-list)
(should-error (rassoc 3 c2) :type 'circular-list)
(should-error (rassoc 3 d1) :type 'wrong-type-argument)
(should-error (rassoc 3 d2) :type 'wrong-type-argument)))
(ert-deftest test-cycle-delq ()
(should-error (delq 1 (cyc1 1)) :type 'circular-list)
(should-error (delq 1 (cyc2 1 2)) :type 'circular-list)
(should-error (delq 1 (dot1 1)) :type 'wrong-type-argument)
(should-error (delq 1 (dot2 1 2)) :type 'wrong-type-argument)
(should-error (delq 2 (cyc1 1)) :type 'circular-list)
(should-error (delq 2 (cyc2 1 2)) :type 'circular-list)
(should-error (delq 2 (dot1 1)) :type 'wrong-type-argument)
(should-error (delq 2 (dot2 1 2)) :type 'wrong-type-argument)
(should-error (delq 3 (cyc1 1)) :type 'circular-list)
(should-error (delq 3 (cyc2 1 2)) :type 'circular-list)
(should-error (delq 3 (dot1 1)) :type 'wrong-type-argument)
(should-error (delq 3 (dot2 1 2)) :type 'wrong-type-argument))
(ert-deftest test-cycle-delete ()
(should-error (delete 1 (cyc1 1)) :type 'circular-list)
(should-error (delete 1 (cyc2 1 2)) :type 'circular-list)
(should-error (delete 1 (dot1 1)) :type 'wrong-type-argument)
(should-error (delete 1 (dot2 1 2)) :type 'wrong-type-argument)
(should-error (delete 2 (cyc1 1)) :type 'circular-list)
(should-error (delete 2 (cyc2 1 2)) :type 'circular-list)
(should-error (delete 2 (dot1 1)) :type 'wrong-type-argument)
(should-error (delete 2 (dot2 1 2)) :type 'wrong-type-argument)
(should-error (delete 3 (cyc1 1)) :type 'circular-list)
(should-error (delete 3 (cyc2 1 2)) :type 'circular-list)
(should-error (delete 3 (dot1 1)) :type 'wrong-type-argument)
(should-error (delete 3 (dot2 1 2)) :type 'wrong-type-argument))
(ert-deftest test-cycle-reverse ()
(should-error (reverse (cyc1 1)) :type 'circular-list)
(should-error (reverse (cyc2 1 2)) :type 'circular-list)
(should-error (reverse (dot1 1)) :type 'wrong-type-argument)
(should-error (reverse (dot2 1 2)) :type 'wrong-type-argument))
(ert-deftest test-cycle-plist-get ()
(let ((c1 (cyc1 1))
(c2 (cyc2 1 2))
(d1 (dot1 1))
(d2 (dot2 1 2)))
(should (plist-get c1 1))
(should (plist-get c2 1))
(should (plist-get d1 1))
(should (plist-get d2 1))
(should-not (plist-get c1 2))
(should (plist-get c2 2))
(should-not (plist-get d1 2))
(should (plist-get d2 2))
(should-not (plist-get c1 3))
(should-not (plist-get c2 3))
(should-not (plist-get d1 3))
(should-not (plist-get d2 3))))
(ert-deftest test-cycle-lax-plist-get ()
(let ((c1 (cyc1 1))
(c2 (cyc2 1 2))
(d1 (dot1 1))
(d2 (dot2 1 2)))
(should (lax-plist-get c1 1))
(should (lax-plist-get c2 1))
(should (lax-plist-get d1 1))
(should (lax-plist-get d2 1))
(should-error (lax-plist-get c1 2) :type 'circular-list)
(should (lax-plist-get c2 2))
(should-not (lax-plist-get d1 2))
(should (lax-plist-get d2 2))
(should-error (lax-plist-get c1 3) :type 'circular-list)
(should-error (lax-plist-get c2 3) :type 'circular-list)
(should-not (lax-plist-get d1 3))
(should-not (lax-plist-get d2 3))))
(ert-deftest test-cycle-plist-member ()
(let ((c1 (cyc1 1))
(c2 (cyc2 1 2))
(d1 (dot1 1))
(d2 (dot2 1 2)))
(should (plist-member c1 1))
(should (plist-member c2 1))
(should (plist-member d1 1))
(should (plist-member d2 1))
(should-error (plist-member c1 2) :type 'circular-list)
(should (plist-member c2 2))
(should-error (plist-member d1 2) :type 'wrong-type-argument)
(should (plist-member d2 2))
(should-error (plist-member c1 3) :type 'circular-list)
(should-error (plist-member c2 3) :type 'circular-list)
(should-error (plist-member d1 3) :type 'wrong-type-argument)
(should-error (plist-member d2 3) :type 'wrong-type-argument)))
(ert-deftest test-cycle-plist-put ()
(let ((c1 (cyc1 1))
(c2 (cyc2 1 2))
(d1 (dot1 1))
(d2 (dot2 1 2)))
(should (plist-put c1 1 1))
(should (plist-put c2 1 1))
(should (plist-put d1 1 1))
(should (plist-put d2 1 1))
(should-error (plist-put c1 2 2) :type 'circular-list)
(should (plist-put c2 2 2))
(should (plist-put d1 2 2))
(should (plist-put d2 2 2))
(should-error (plist-put c1 3 3) :type 'circular-list)
(should-error (plist-put c2 3 3) :type 'circular-list)
(should (plist-put d1 3 3))
(should (plist-put d2 3 3))))
(ert-deftest test-cycle-lax-plist-put ()
(let ((c1 (cyc1 1))
(c2 (cyc2 1 2))
(d1 (dot1 1))
(d2 (dot2 1 2)))
(should (lax-plist-put c1 1 1))
(should (lax-plist-put c2 1 1))
(should (lax-plist-put d1 1 1))
(should (lax-plist-put d2 1 1))
(should-error (lax-plist-put c1 2 2) :type 'circular-list)
(should (lax-plist-put c2 2 2))
(should (lax-plist-put d1 2 2))
(should (lax-plist-put d2 2 2))
(should-error (lax-plist-put c1 3 3) :type 'circular-list)
(should-error (lax-plist-put c2 3 3) :type 'circular-list)
(should (lax-plist-put d1 3 3))
(should (lax-plist-put d2 3 3))))
(ert-deftest test-cycle-equal ()
(should-error (equal (cyc1 1) (cyc1 1)))
(should-error (equal (cyc2 1 2) (cyc2 1 2))))
(ert-deftest test-cycle-nconc ()
(should-error (nconc (cyc1 1) 'tail) :type 'circular-list)
(should-error (nconc (cyc2 1 2) 'tail) :type 'circular-list))
(provide 'cycle-tests)