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

Add predicate proper-list-p

Browse source 
For discussion, see emacs-devel thread starting at
https://lists.gnu.org/archive/html/emacs-devel/2018-04/msg00460.html.

* lisp/subr.el (proper-list-p): New function.
Implementation suggested by Paul Eggert <eggert@cs.ucla.edu> in
https://lists.gnu.org/archive/html/emacs-devel/2018-06/msg00138.html.
* doc/lispref/lists.texi (List Elements):
* etc/NEWS: Document proper-list-p.
* lisp/org/ob-core.el (org-babel-insert-result):
* lisp/emacs-lisp/byte-opt.el (byte-optimize-if):
* lisp/emacs-lisp/cl-macs.el (cl--make-usage-args): Use proper-list-p.
* lisp/emacs-lisp/ert.el (ert--proper-list-p): Remove.
Replaced by proper-list-p in lisp/subr.el.
(ert--explain-equal-rec): Use proper-list-length.
* lisp/format.el (format-proper-list-p): Remove.
Replaced by proper-list-p in lisp/subr.el.
(format-annotate-single-property-change): Use proper-list-p.
* test/lisp/emacs-lisp/ert-tests.el (ert-test-proper-list-p):
Move from here...
* test/lisp/subr-tests.el (subr-tests--proper-list-length):
...to here, mutatis mutandis.
This commit is contained in:
Basil L. Contovounesios 2018-07-09 18:46:33 -07:00 • committed by Paul Eggert
parent e4ad2d1a8f
commit 2fde6275b6
10 changed files with 59 additions and 78 deletions
Download patch file Download diff file Expand all files Collapse all files

28
lisp/emacs-lisp/ert.el
View file

@ -472,18 +472,6 @@ Errors during evaluation are caught and handled like nil."
;; buffer. Perhaps explanations should be reported through `ert-info'
;; rather than as part of the condition.
(defun ert--proper-list-p (x)
"Return non-nil if X is a proper list, nil otherwise."
(cl-loop
for firstp = t then nil
for fast = x then (cddr fast)
for slow = x then (cdr slow) do
(when (null fast) (cl-return t))
(when (not (consp fast)) (cl-return nil))
(when (null (cdr fast)) (cl-return t))
(when (not (consp (cdr fast))) (cl-return nil))
(when (and (not firstp) (eq fast slow)) (cl-return nil))))
(defun ert--explain-format-atom (x)
"Format the atom X for `ert--explain-equal'."
(pcase x
@ -494,17 +482,17 @@ Errors during evaluation are caught and handled like nil."
(defun ert--explain-equal-rec (a b)
"Return a programmer-readable explanation of why A and B are not `equal'.
Returns nil if they are."
(if (not (equal (type-of a) (type-of b)))
(if (not (eq (type-of a) (type-of b)))
`(different-types ,a ,b)
(pcase-exhaustive a
((pred consp)
(let ((a-proper-p (ert--proper-list-p a))
(b-proper-p (ert--proper-list-p b)))
(if (not (eql (not a-proper-p) (not b-proper-p)))
(let ((a-length (proper-list-p a))
(b-length (proper-list-p b)))
(if (not (eq (not a-length) (not b-length)))
`(one-list-proper-one-improper ,a ,b)
(if a-proper-p
(if (not (equal (length a) (length b)))
`(proper-lists-of-different-length ,(length a) ,(length b)
(if a-length
(if (/= a-length b-length)
`(proper-lists-of-different-length ,a-length ,b-length
,a ,b
first-mismatch-at
,(cl-mismatch a b :test 'equal))
@ -523,7 +511,7 @@ Returns nil if they are."
(cl-assert (equal a b) t)
nil))))))))
((pred arrayp)
(if (not (equal (length a) (length b)))
(if (/= (length a) (length b))
`(arrays-of-different-length ,(length a) ,(length b)
,a ,b
,@(unless (char-table-p a)