[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 54b8ec4 2/2: Remove workaround for fixed Bug#6581 from ert
|
From: |
Stefan Kangas |
|
Subject: |
master 54b8ec4 2/2: Remove workaround for fixed Bug#6581 from ert |
|
Date: |
Sat, 30 Oct 2021 22:15:06 -0400 (EDT) |
branch: master
commit 54b8ec4e6fb1eeac049e7bd68372e78c180fe8e4
Author: Stefan Kangas <stefan@marxist.se>
Commit: Stefan Kangas <stefan@marxist.se>
Remove workaround for fixed Bug#6581 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 f7cf1e4..aff3804 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -89,24 +89,6 @@ Use nil for no limit (caution: backtrace lines can be very
long)."
: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 @@ 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."
+Return nil if they are."
(if (not (eq (type-of a) (type-of b)))
`(different-types ,a ,b)
(pcase a
@@ -600,14 +582,9 @@ If SUFFIXP is non-nil, returns a suffix of S, otherwise a
prefix."
(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 @@ Returns a programmer-readable explanation of why A and B
are not
,(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'.
@@ -2787,6 +2766,12 @@ TRANSFORM will be called to get from before to after."
(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 39b7b47..79576d2 100644
--- a/test/lisp/emacs-lisp/ert-tests.el
+++ b/test/lisp/emacs-lisp/ert-tests.el
@@ -695,35 +695,40 @@ This macro is used to test if macroexpansion in `should'
works."
(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 9f40a18..1784934 100644
--- a/test/lisp/emacs-lisp/ert-x-tests.el
+++ b/test/lisp/emacs-lisp/ert-x-tests.el
@@ -90,10 +90,10 @@
"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 @@
"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 @@
;; 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 a731a95..e83dd7c 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 @@
#(" 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 @@
;; 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"))))))