From 7af3861c4a18723abb04aada315e4515cd54ed18 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Thu, 21 Oct 2021 19:53:00 +0200 Subject: [PATCH 2/2] Remove workaround for fixed Bug#6541 from ert * lisp/emacs-lisp/ert.el (ert-equal-including-properties): Make into obsolete function alias for 'equal-including-properties'. * test/src/editfns-tests.el (format-properties): * test/lisp/emacs-lisp/ert-x-tests.el (ert-propertized-string) (ert-test-run-tests-interactively-2): Don't use above obsolete name. (ert--explain-equal-including-properties-rec): New function. (ert--explain-equal-including-properties): Use as an explainer for 'equal-including-properties' now that Bug#6581 is fixed. * test/lisp/emacs-lisp/ert-tests.el (ert-test-explain-equal-string-properties): Expand test. (ert-test-equal-including-properties): Merge test into above expanded test. --- lisp/emacs-lisp/ert.el | 55 +++++++++++------------------ test/lisp/emacs-lisp/ert-tests.el | 55 ++++++++++++++++------------- test/lisp/emacs-lisp/ert-x-tests.el | 8 ++--- test/src/editfns-tests.el | 48 ++++++++++++------------- 4 files changed, 78 insertions(+), 88 deletions(-) diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index a5b5258c3e..464680cd06 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -89,24 +89,6 @@ ert-test-result-unexpected :background "red3")) "Face used for unexpected results in the ERT results buffer.") - -;;; Copies/reimplementations of cl functions. - -;; FIXME: Bug#6581 is fixed, so this should be deleted. -(defun ert-equal-including-properties (a b) - "Return t if A and B have similar structure and contents. - -This is like `equal-including-properties' except that it compares -the property values of text properties structurally (by -recursing) rather than with `eq'. Perhaps this is what -`equal-including-properties' should do in the first place; see -Emacs bug 6581 at URL `https://debbugs.gnu.org/cgi/bugreport.cgi?bug=6581'." - ;; This implementation is inefficient. Rather than making it - ;; efficient, let's hope bug 6581 gets fixed so that we can delete - ;; it altogether. - (not (ert--explain-equal-including-properties a b))) - - ;;; Defining and locating tests. ;; The data structure that represents a test case. @@ -467,7 +449,7 @@ ert--explain-format-atom (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." +Return nil if they are." (if (not (eq (type-of a) (type-of b))) `(different-types ,a ,b) (pcase a @@ -600,14 +582,9 @@ ert--abbreviate-string (t (substring s 0 len))))) -;; TODO(ohler): Once bug 6581 is fixed, rename this to -;; `ert--explain-equal-including-properties-rec' and add a fast-path -;; wrapper like `ert--explain-equal'. -(defun ert--explain-equal-including-properties (a b) - "Explainer function for `ert-equal-including-properties'. - -Returns a programmer-readable explanation of why A and B are not -`ert-equal-including-properties', or nil if they are." +(defun ert--explain-equal-including-properties-rec (a b) + "Return explanation of why A and B are not `equal-including-properties'. +Return nil if they are." (if (not (equal a b)) (ert--explain-equal a b) (cl-assert (stringp a) t) @@ -629,15 +606,17 @@ ert--explain-equal-including-properties ,(ert--abbreviate-string (substring-no-properties a (1+ i)) 10 nil)))) - ;; TODO(ohler): Get `equal-including-properties' fixed in - ;; Emacs, delete `ert-equal-including-properties', and - ;; re-enable this assertion. - ;;finally (cl-assert (equal-including-properties a b) t) - ))) -(put 'ert-equal-including-properties - 'ert-explainer - 'ert--explain-equal-including-properties) + finally (cl-assert (equal-including-properties a b) t)))) +(defun ert--explain-equal-including-properties (a b) + "Explainer function for `equal-including-properties'." + ;; Do a quick comparison in C to avoid running our expensive + ;; comparison when possible. + (if (equal-including-properties a b) + nil + (ert--explain-equal-including-properties-rec a b))) +(put 'equal-including-properties 'ert-explainer + 'ert--explain-equal-including-properties) ;;; Implementation of `ert-info'. @@ -2786,6 +2765,12 @@ ert--erts-specifications (defvar ert-unload-hook ()) (add-hook 'ert-unload-hook #'ert--unload-function) +;;; Obsolete + +(define-obsolete-function-alias 'ert-equal-including-properties + #'equal-including-properties "29.1") +(put 'ert-equal-including-properties 'ert-explainer + 'ert--explain-equal-including-properties) (provide 'ert) diff --git a/test/lisp/emacs-lisp/ert-tests.el b/test/lisp/emacs-lisp/ert-tests.el index 39b7b47555..79576d2403 100644 --- a/test/lisp/emacs-lisp/ert-tests.el +++ b/test/lisp/emacs-lisp/ert-tests.el @@ -695,35 +695,40 @@ ert-test-abbreviate-string (should (equal (ert--abbreviate-string "bar" 0 t) ""))) (ert-deftest ert-test-explain-equal-string-properties () - (should - (equal (ert--explain-equal-including-properties #("foo" 0 1 (a b)) - "foo") - '(char 0 "f" - (different-properties-for-key a (different-atoms b nil)) - context-before "" - context-after "oo"))) - (should (equal (ert--explain-equal-including-properties + (should-not (ert--explain-equal-including-properties-rec "foo" "foo")) + (should-not (ert--explain-equal-including-properties-rec + #("foo" 0 3 (a b)) + (propertize "foo" 'a 'b))) + (should-not (ert--explain-equal-including-properties-rec + #("foo" 0 3 (a b c d)) + (propertize "foo" 'a 'b 'c 'd))) + (should-not (ert--explain-equal-including-properties-rec + #("foo" 0 3 (a (t))) + (propertize "foo" 'a (list t)))) + + (should (equal (ert--explain-equal-including-properties-rec + #("foo" 0 3 (a b c e)) + (propertize "foo" 'a 'b 'c 'd)) + '(char 0 "f" (different-properties-for-key c (different-atoms e d)) + context-before "" + context-after "oo"))) + (should (equal (ert--explain-equal-including-properties-rec + #("foo" 0 1 (a b)) + "foo") + '(char 0 "f" + (different-properties-for-key a (different-atoms b nil)) + context-before "" + context-after "oo"))) + (should (equal (ert--explain-equal-including-properties-rec #("foo" 1 3 (a b)) #("goo" 0 1 (c d))) '(array-elt 0 (different-atoms (?f "#x66" "?f") (?g "#x67" "?g"))))) - (should - (equal (ert--explain-equal-including-properties - #("foo" 0 1 (a b c d) 1 3 (a b)) - #("foo" 0 1 (c d a b) 1 2 (a foo))) - '(char 1 "o" (different-properties-for-key a (different-atoms b foo)) - context-before "f" context-after "o")))) - -(ert-deftest ert-test-equal-including-properties () - (should (ert-equal-including-properties "foo" "foo")) - (should (ert-equal-including-properties #("foo" 0 3 (a b)) - (propertize "foo" 'a 'b))) - (should (ert-equal-including-properties #("foo" 0 3 (a b c d)) - (propertize "foo" 'a 'b 'c 'd))) - (should-not (ert-equal-including-properties #("foo" 0 3 (a b c e)) - (propertize "foo" 'a 'b 'c 'd))) - (should (ert-equal-including-properties #("foo" 0 3 (a (t))) - (propertize "foo" 'a (list t))))) + (should (equal (ert--explain-equal-including-properties-rec + #("foo" 0 1 (a b c d) 1 3 (a b)) + #("foo" 0 1 (c d a b) 1 2 (a foo))) + '(char 1 "o" (different-properties-for-key a (different-atoms b foo)) + context-before "f" context-after "o")))) (ert-deftest ert-test-stats-set-test-and-result () (let* ((test-1 (make-ert-test :name 'test-1 diff --git a/test/lisp/emacs-lisp/ert-x-tests.el b/test/lisp/emacs-lisp/ert-x-tests.el index 9f40a18d34..1784934acb 100644 --- a/test/lisp/emacs-lisp/ert-x-tests.el +++ b/test/lisp/emacs-lisp/ert-x-tests.el @@ -90,10 +90,10 @@ ert-filter-string "foo baz"))) (ert-deftest ert-propertized-string () - (should (ert-equal-including-properties + (should (equal-including-properties (ert-propertized-string "a" '(a b) "b" '(c t) "cd") #("abcd" 1 2 (a b) 2 4 (c t)))) - (should (ert-equal-including-properties + (should (equal-including-properties (ert-propertized-string "foo " '(face italic) "bar" " baz" nil " quux") #("foo bar baz quux" 4 11 (face italic))))) @@ -166,7 +166,7 @@ ert-test-run-tests-interactively-2 "1 skipped")))) (with-current-buffer buffer-name (font-lock-mode 0) - (should (ert-equal-including-properties + (should (equal-including-properties (ert-filter-string (buffer-string) '("Started at:\\(.*\\)$" 1) '("Finished at:\\(.*\\)$" 1)) @@ -175,7 +175,7 @@ ert-test-run-tests-interactively-2 ;; pretend we are. (let ((noninteractive nil)) (font-lock-mode 1)) - (should (ert-equal-including-properties + (should (equal-including-properties (ert-filter-string (buffer-string) '("Started at:\\(.*\\)$" 1) '("Finished at:\\(.*\\)$" 1)) diff --git a/test/src/editfns-tests.el b/test/src/editfns-tests.el index a731a95ccf..e83dd7c857 100644 --- a/test/src/editfns-tests.el +++ b/test/src/editfns-tests.el @@ -23,16 +23,16 @@ (ert-deftest format-properties () ;; Bug #23730 - (should (ert-equal-including-properties + (should (equal-including-properties (format (propertize "%d" 'face '(:background "red")) 1) #("1" 0 1 (face (:background "red"))))) - (should (ert-equal-including-properties + (should (equal-including-properties (format (propertize "%2d" 'face '(:background "red")) 1) #(" 1" 0 2 (face (:background "red"))))) - (should (ert-equal-including-properties + (should (equal-including-properties (format (propertize "%02d" 'face '(:background "red")) 1) #("01" 0 2 (face (:background "red"))))) - (should (ert-equal-including-properties + (should (equal-including-properties (format (concat (propertize "%2d" 'x 'X) (propertize "a" 'a 'A) (propertize "b" 'b 'B)) @@ -40,27 +40,27 @@ format-properties #(" 1ab" 0 2 (x X) 2 3 (a A) 3 4 (b B)))) ;; Bug #5306 - (should (ert-equal-including-properties + (should (equal-including-properties (format "%.10s" (concat "1234567890aaaa" (propertize "12345678901234567890" 'xxx 25))) "1234567890")) - (should (ert-equal-including-properties + (should (equal-including-properties (format "%.10s" (concat "123456789" (propertize "12345678901234567890" 'xxx 25))) #("1234567891" 9 10 (xxx 25)))) ;; Bug #23859 - (should (ert-equal-including-properties + (should (equal-including-properties (format "%4s" (propertize "hi" 'face 'bold)) #(" hi" 2 4 (face bold)))) ;; Bug #23897 - (should (ert-equal-including-properties + (should (equal-including-properties (format "%s" (concat (propertize "01234" 'face 'bold) "56789")) #("0123456789" 0 5 (face bold)))) - (should (ert-equal-including-properties + (should (equal-including-properties (format "%s" (concat (propertize "01" 'face 'bold) (propertize "23" 'face 'underline) "45")) @@ -68,63 +68,63 @@ format-properties ;; The last property range is extended to include padding on the ;; right, but the first range is not extended to the left to include ;; padding on the left! - (should (ert-equal-including-properties + (should (equal-including-properties (format "%12s" (concat (propertize "01234" 'face 'bold) "56789")) #(" 0123456789" 2 7 (face bold)))) - (should (ert-equal-including-properties + (should (equal-including-properties (format "%-12s" (concat (propertize "01234" 'face 'bold) "56789")) #("0123456789 " 0 5 (face bold)))) - (should (ert-equal-including-properties + (should (equal-including-properties (format "%10s" (concat (propertize "01" 'face 'bold) (propertize "23" 'face 'underline) "45")) #(" 012345" 4 6 (face bold) 6 8 (face underline)))) - (should (ert-equal-including-properties + (should (equal-including-properties (format "%-10s" (concat (propertize "01" 'face 'bold) (propertize "23" 'face 'underline) "45")) #("012345 " 0 2 (face bold) 2 4 (face underline)))) - (should (ert-equal-including-properties + (should (equal-including-properties (format "%-10s" (concat (propertize "01" 'face 'bold) (propertize "23" 'face 'underline) (propertize "45" 'face 'italic))) #("012345 " 0 2 (face bold) 2 4 (face underline) 4 10 (face italic)))) ;; Bug #38191 - (should (ert-equal-including-properties + (should (equal-including-properties (format (propertize "‘foo’ %s bar" 'face 'bold) "xxx") #("‘foo’ xxx bar" 0 13 (face bold)))) ;; Bug #32404 - (should (ert-equal-including-properties + (should (equal-including-properties (format (concat (propertize "%s" 'face 'bold) "" (propertize "%s" 'face 'error)) "foo" "bar") #("foobar" 0 3 (face bold) 3 6 (face error)))) - (should (ert-equal-including-properties + (should (equal-including-properties (format (concat "%s" (propertize "%s" 'face 'error)) "foo" "bar") #("foobar" 3 6 (face error)))) - (should (ert-equal-including-properties + (should (equal-including-properties (format (concat "%s " (propertize "%s" 'face 'error)) "foo" "bar") #("foo bar" 4 7 (face error)))) ;; Bug #46317 (let ((s (propertize "X" 'prop "val"))) - (should (ert-equal-including-properties + (should (equal-including-properties (format (concat "%3s/" s) 12) #(" 12/X" 4 5 (prop "val")))) - (should (ert-equal-including-properties + (should (equal-including-properties (format (concat "%3S/" s) 12) #(" 12/X" 4 5 (prop "val")))) - (should (ert-equal-including-properties + (should (equal-including-properties (format (concat "%3d/" s) 12) #(" 12/X" 4 5 (prop "val")))) - (should (ert-equal-including-properties + (should (equal-including-properties (format (concat "%-3s/" s) 12) #("12 /X" 4 5 (prop "val")))) - (should (ert-equal-including-properties + (should (equal-including-properties (format (concat "%-3S/" s) 12) #("12 /X" 4 5 (prop "val")))) - (should (ert-equal-including-properties + (should (equal-including-properties (format (concat "%-3d/" s) 12) #("12 /X" 4 5 (prop "val")))))) -- 2.30.2