Function: ert--explain-equal-rec

ert--explain-equal-rec is a byte-compiled function defined in ert.el.gz.

Signature

(ert--explain-equal-rec A B)

Documentation

Return a programmer-readable explanation of why A and B are not equal.

Returns nil if they are.

Source Code

;; Defined in /usr/src/emacs/lisp/emacs-lisp/ert.el.gz
(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 (eq (type-of a) (type-of b)))
      `(different-types ,a ,b)
    (pcase a
      ((pred consp)
       (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-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))
                 (cl-loop for i from 0
                          for ai in a
                          for bi in b
                          for xi = (ert--explain-equal-rec ai bi)
                          do (when xi (cl-return `(list-elt ,i ,xi)))
                          finally (cl-assert (equal a b) t)))
             (let ((car-x (ert--explain-equal-rec (car a) (car b))))
               (if car-x
                   `(car ,car-x)
                 (let ((cdr-x (ert--explain-equal-rec (cdr a) (cdr b))))
                   (if cdr-x
                       `(cdr ,cdr-x)
                     (cl-assert (equal a b) t)
                     nil))))))))
      ((pred cl-struct-p)
       (cl-loop for slot in (cl-struct-slot-info (type-of a))
                for ai across a
                for bi across b
                for xf = (ert--explain-equal-rec ai bi)
                do (when xf (cl-return `(struct-field ,(car slot) ,xf)))
                finally (cl-assert (equal a b) t)))
      ((or (pred arrayp) (pred recordp))
       ;; For mixed unibyte/multibyte string comparisons, make both multibyte.
       (when (and (stringp a)
                  (xor (multibyte-string-p a) (multibyte-string-p b)))
         (setq a (string-to-multibyte a))
         (setq b (string-to-multibyte b)))
       (if (/= (length a) (length b))
           `(arrays-of-different-length ,(length a) ,(length b)
                                        ,a ,b
                                        ,@(unless (char-table-p a)
                                            `(first-mismatch-at
                                              ,(cl-mismatch a b :test 'equal))))
         (cl-loop for i from 0
                  for ai across a
                  for bi across b
                  for xi = (ert--explain-equal-rec ai bi)
                  do (when xi (cl-return `(array-elt ,i ,xi)))
                  finally (cl-assert (equal a b) t))))
      (_
       (if (not (equal a b))
           (if (and (symbolp a) (symbolp b) (string= a b))
               `(different-symbols-with-the-same-name ,a ,b)
             `(different-atoms ,(ert--explain-format-atom a)
                               ,(ert--explain-format-atom b)))
         nil)))))