Re: [PATCH] testing: Delete duplicate tests

[Ilya Chernyshov <ichernyshovvv@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 713 bytes --]

Ihor Radchenko <yantar92@posteo.net> writes:

> I saw you using your function to detect the existing duplicate tests.
> However, it would also be nice to add it as a test of its own to detect
> duplicates in future. WDYT?

Sure, here it is. In the patch, I added a new file
(testing/lisp/test-deduplicator.el) with a test that checks for
duplicate forms (not just should, should-not, should-error macros) in
all test files.

Changes in other files serve as an example of how to use
`org-test-ignore-duplicate' to make sure that the test deduplicator
skips certain duplicate forms.

There's a lot of tests to change before merging. I'll handle them and
submit a new patch if you have no questions about the code.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-testing-Add-testing-lisp-test-deduplicator.el.patch --]
[-- Type: text/x-patch, Size: 15636 bytes --]

From 3b38450f7de8bd168d8795728454d9f4db720843 Mon Sep 17 00:00:00 2001
From: Ilya Chernyshov <ichernyshovvv@gmail.com>
Date: Tue, 5 Sep 2023 22:40:59 +0700
Subject: [PATCH] testing: Add testing/lisp/test-deduplicator.el

* testing/lisp/test-deduplicator.el: Add test unit that checks for
duplicate forms in ert tests.

* testing/lisp/test-ob-lob.el (test-ob-lob/caching-call-line,
test-ob-lob/named-caching-call-line, test-ob/just-one-results-block):
Ignore duplicate forms via `org-test-ignore-duplicate'

* testing/lisp/test-ob.el (test-ob/just-one-results-block): Ignore
duplicate forms via `org-test-ignore-duplicate'

* testing/lisp/test-org.el (test-org/goto-sibling,
test-org/backward-element, test-org/up-element): Ignore duplicate
forms via `org-test-ignore-duplicate'
---
 testing/lisp/test-deduplicator.el | 224 ++++++++++++++++++++++++++++++
 testing/lisp/test-ob-lob.el       |  10 +-
 testing/lisp/test-ob.el           |   3 +-
 testing/lisp/test-org.el          |  81 ++++++-----
 4 files changed, 275 insertions(+), 43 deletions(-)
 create mode 100644 testing/lisp/test-deduplicator.el

diff --git a/testing/lisp/test-deduplicator.el b/testing/lisp/test-deduplicator.el
new file mode 100644
index 000000000..28b5d66f0
--- /dev/null
+++ b/testing/lisp/test-deduplicator.el
@@ -0,0 +1,224 @@
+;;; test-deduplicator.el --- Tests for finding duplicates in Org tests  -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2023  Ilya Chernyshov
+;; Authors: Ilya Chernyshov <ichernyshovvv@gmail.com>
+
+;; This file is not part of GNU Emacs.
+
+;; 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 <https://www.gnu.org/licenses/>.
+;;
+;;; Commentary:
+
+;; Unit tests that check for duplicate forms (including `should',
+;; `should-not', `should-error') in all Org test files.  Forms are
+;; considered duplicate if they are `equal-including-properties' and
+;; nested at the same level.  To ignore a form or a group of forms,
+;; wrap them in `org-test-ignore-duplicate'.
+
+;;; Code:
+
+(require 'org-test "../testing/org-test")
+
+(defvar test-deduplicator-files
+  (directory-files (expand-file-name "lisp" org-test-dir) t "\\.el$"))
+
+(defvar test-deduplicator-duplicate-forms nil
+  "A nested list of the form:
+
+  (((file test-name [(form-1 . numerical-order)
+                     (form-2 . numerical-order) ...])
+    (dup-form-1 . (numerical-order [numerical-order ...]))
+  [ (dup-form-2 . (numerical-order [numerical-order ...]))
+    (dup-form-3 . (numerical-order [numerical-order ...]))
+     ...])
+   
+   ((file test-name [(form-1 . numerical-order)
+                     (form-2 . numerical-order) ...])
+    (dup-form-1 . (numerical-order [numerical-order ...]))
+  [ (dup-form-2 . (numerical-order [numerical-order ...]))
+    (dup-form-3 . (numerical-order [numerical-order ...]))
+     ...])
+
+   ...
+  )
+
+Where
+
+  (file test-name [(form-1 . numerical-order)
+                   (form-2 . numerical-order) ...])
+
+is a path to duplicates.  For example, the path for the
+duplicates in the following test:
+
+                                             test-ob-haskell-ghci.el
+
+  (ertdeftest ob-haskell/session-named-none-means-one-shot-sessions ()
+    \"When no session, use a new session.
+  \"none\" is a special name that means `no session'.\"
+    (let ((var-1 \"value\"))
+     (when var-1
+       (should-not (equal 2 (test-ob-haskell-ghci \":session \"none\"\" \"x\" nil)))
+       (test-ob-haskell-ghci \":session none\" \"x=2\")
+       (should-not (equal 2 (test-ob-haskell-ghci \":session \"none\"\" \"x\" nil)))
+       (test-ob-haskell-ghci \":session none\" \"x=2\"))))
+
+would look like this:
+
+  (\"test-ob-haskell-ghci.el\"
+    ob-haskell/session-named-none-means-one-shot-sessions
+    (let . 4) (when . 2))
+
+And the records about the duplicates would look like this:
+
+  ((test-ob-haskell-ghci \":session none\" \"x=2\") 5 3)
+  ((should-not (equal 2 (test-ob-haskell-ghci \":session \"none\"\" \"x\" nil))) 4 2)")
+
+(defvar test-deduplicator-forms nil
+  "Nested alist of found forms and paths to them (not filtered).")
+
+(defmacro org-test-ignore-duplicate (&rest body)
+  "Eval BODY forms sequentially and return value of last one.
+
+The macro's body will be ignored by
+`test-deduplicator/detect-duplicate-tests' test to ignore
+duplicate forms inside the body."
+  (declare (indent 0))
+  `(progn ,@body))
+
+(ert-deftest test-org-tests/detect-duplicate-tests ()
+  "Try to find duplicate forms."
+  
+  (should-not (test-deduplicator-find-duplicates test-deduplicator-files)))
+
+(defun test-deduplicator-find-duplicates (files)
+  "Try to find duplicate forms in FILES.
+
+If duplicates are found, record them into
+`test-deduplicator-duplicate-forms', `message' paths to them in a
+human-readable format and return the value.
+
+Forms are considered duplicate if they are nested at the same
+level."
+  (setq test-deduplicator-forms nil)
+  (dolist (file files)
+    (with-current-buffer (find-file-noselect file)
+      (save-excursion
+        (goto-char (point-min))
+        (while (search-forward "(ert-deftest" nil t)
+          (goto-char (match-beginning 0))
+          (ignore-errors
+	    (while-let ((form (or (read (current-buffer)) t)))
+	      (test-deduplicator-search-forms-recursively
+               form (list file (cadr form)))))))))
+  (setq test-deduplicator-duplicate-forms
+        (seq-filter
+         #'cdr (mapcar
+                (lambda (file)
+                  (cons
+                   (car file)
+                   (seq-filter #'caddr (cdr file))))
+                test-deduplicator-forms)))
+  (when test-deduplicator-duplicate-forms
+    (let ((res (concat "Found duplicates (To ignore duplicate forms,\n"
+                       "wrap them in `org-test-ignore-duplicate'):\n")))
+      (dolist (path test-deduplicator-duplicate-forms)
+        (let* ((file (file-relative-name (caar path)))
+               (test-name (symbol-name (cadar path)))
+               (path-inside-test (cddar path))
+               (result "")
+               (string-path (append (list file test-name)
+                                    (mapcar (lambda (x)
+                                              (symbol-name (car x)))
+                                            path-inside-test)))
+               (iter 0)
+               (print-level 3))
+          (dolist (x string-path)
+            (cl-callf concat result
+	      (format "%s%s\n" (make-string (* iter 2) ? ) x))
+            (cl-incf iter))
+          (cl-callf concat result
+            (mapconcat
+             (lambda (x) (format "%s%S: %d times\n"
+                                 (make-string (* iter 2) ? )
+                                 (car x)
+                                 (length (cdr x))))
+             (cdr path)))
+          (cl-callf concat res result)))
+      (message "%s" res)))
+  test-deduplicator-duplicate-forms)
+
+(defun test-deduplicator-search-forms-recursively (form form-path)
+  "Search for forms recursively in FORM.
+
+FORM-PATH is list of the form:
+  (\"file-path\" ert-test-symbol
+    (symbol-1 . sexp-order-1) (symbol-2 . sexp-order-2))
+
+Write each form to `test-deduplicator-forms'"
+  (dotimes (iter (length form))
+    (pcase (car-safe (nth iter form))
+      ((or `skip-unless `org-test-ignore-duplicate))
+      ((pred (not null))
+       (push iter (alist-get (nth iter form)
+                             (alist-get form-path test-deduplicator-forms
+                                        nil nil #'equal)
+                             nil nil #'equal-including-properties))
+       (unless (member (car-safe (nth iter form))
+		       '(should-not should should-error))
+	 (test-deduplicator-search-forms-recursively
+          (nth iter form)
+          (append form-path (list (cons (car (nth iter form)) iter)))))))))
+
+;;; Tests
+
+(defvar test-deduplicator-file-path
+  (expand-file-name "test-deduplicator.el"
+                    (expand-file-name "lisp" org-test-dir)))
+
+(ert-deftest test-org-tests/testing-test-deduplicator ()
+  ""
+  (should
+   (equal
+    (test-deduplicator-find-duplicates
+     (list test-deduplicator-file-path))
+    `(((,(expand-file-name "lisp/test-deduplicator.el" org-test-dir)
+        test-org-tests/test-with-nested-duplicates)
+       ((format "%s" "string") 7 5)
+       ((let ((var "string")) (should (message "123 %s" var))) 6 4))
+      (((expand-file-name "lisp/test-deduplicator.el" org-test-dir)
+        test-org-tests/test-with-duplicates-at-root)
+       ((should (message "123")) 6 4))))))
+
+;;; Tests with duplicate forms to check the deduplicator
+
+(ert-deftest test-org-tests/test-with-duplicates-at-root ()
+  "Test with duplicates at the root."
+  (should (message "123"))
+  (format "%s" "string")
+  (should
+   (message "123")))
+
+(ert-deftest test-org-tests/test-with-nested-duplicates ()
+  "Test with nested duplicates."
+  (let ((var "string"))
+    (should
+     (message "123 %s" var)))
+  (format "%s" "string")
+  (let ((var "string"))
+    (should (message "123 %s" var)))
+  (format "%s" "string"))
+
+(provide 'test-deduplicator)
+
+;;; test-deduplicator.el ends here
diff --git a/testing/lisp/test-ob-lob.el b/testing/lisp/test-ob-lob.el
index 188fee4c0..66dfd0eab 100644
--- a/testing/lisp/test-ob-lob.el
+++ b/testing/lisp/test-ob-lob.el
@@ -152,8 +152,9 @@ for export
       (should
        (eq (org-babel-execute-src-block nil (org-babel-lob-get-info)) 1))
       ;; if cached, second evaluation will retain the t value
-      (should
-       (eq (org-babel-execute-src-block nil (org-babel-lob-get-info)) 1)))))
+      (org-test-ignore-duplicate
+        (should
+         (eq (org-babel-execute-src-block nil (org-babel-lob-get-info)) 1))))))
 
 (ert-deftest test-ob-lob/named-caching-call-line ()
   (let ((temporary-value-for-test 0))
@@ -170,8 +171,9 @@ for export
       (should
        (eq (org-babel-execute-src-block nil (org-babel-lob-get-info)) 1))
       ;; if cached, second evaluation will retain the t value
-      (should
-       (eq (org-babel-execute-src-block nil (org-babel-lob-get-info)) 1)))))
+      (org-test-ignore-duplicate
+        (should
+         (eq (org-babel-execute-src-block nil (org-babel-lob-get-info)) 1))))))
 
 (ert-deftest test-ob-lob/assignment-with-newline ()
   "Test call lines with an argument containing a newline character."
diff --git a/testing/lisp/test-ob.el b/testing/lisp/test-ob.el
index 42c77ca56..0153de889 100644
--- a/testing/lisp/test-ob.el
+++ b/testing/lisp/test-ob.el
@@ -645,7 +645,8 @@ duplicate results block."
     (org-babel-execute-src-block)
     (org-babel-execute-src-block)     ; second code block execution
     (should (search-forward "Hello")) ; the string inside the source code block
-    (should (search-forward "Hello")) ; the same string in the results block
+    (org-test-ignore-duplicate
+      (should (search-forward "Hello"))) ; the same string in the results block
     (should-error (search-forward "Hello"))))
 
 (ert-deftest test-ob/nested-code-block ()
diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el
index 612bfa1e5..4e23488be 100644
--- a/testing/lisp/test-org.el
+++ b/testing/lisp/test-org.el
@@ -2490,7 +2490,8 @@ Text.
     (should-not (org-goto-sibling))
     (should (org-goto-sibling 'previous))
     (should (looking-at-p "^\\*\\* Heading 2"))
-    (should (org-goto-sibling 'previous))
+    (org-test-ignore-duplicate
+      (should (org-goto-sibling 'previous)))
     (should (looking-at-p "^\\*\\* Heading 1"))
     (should-not (org-goto-sibling 'previous)))
   ;; Inside heading.
@@ -2533,7 +2534,8 @@ test <point>
       (should-not (org-goto-sibling))
       (should (org-goto-sibling 'previous))
       (should (looking-at-p "^\\*\\* Heading 2"))
-      (should (org-goto-sibling 'previous))
+      (org-test-ignore-duplicate
+        (should (org-goto-sibling 'previous)))
       (should (looking-at-p "^\\*\\* Heading 1"))
       (should-not (org-goto-sibling 'previous)))))
 
@@ -5223,27 +5225,28 @@ Outside."
     ;; 7.1. At beginning of sub-list: expected to move to the
     ;;      paragraph before it.
     (goto-line 4)
-    (org-backward-element)
-    (should (looking-at "item1"))
-    ;; 7.2. At an item in a list: expected to move at previous item.
-    (goto-line 8)
-    (org-backward-element)
-    (should (looking-at "  - sub2"))
-    (goto-line 12)
-    (org-backward-element)
-    (should (looking-at "- item1"))
-    ;; 7.3. At end of list/sub-list: expected to move to list/sub-list
-    ;;      beginning.
-    (goto-line 10)
-    (org-backward-element)
-    (should (looking-at "  - sub1"))
-    (goto-line 15)
-    (org-backward-element)
-    (should (looking-at "- item1"))
-    ;; 7.4. At blank-lines before list end: expected to move to top
-    ;; item.
-    (goto-line 14)
-    (org-backward-element)
+    (org-test-ignore-duplicate
+      (org-backward-element)
+      (should (looking-at "item1"))
+      ;; 7.2. At an item in a list: expected to move at previous item.
+      (goto-line 8)
+      (org-backward-element)
+      (should (looking-at "  - sub2"))
+      (goto-line 12)
+      (org-backward-element)
+      (should (looking-at "- item1"))
+      ;; 7.3. At end of list/sub-list: expected to move to list/sub-list
+      ;;      beginning.
+      (goto-line 10)
+      (org-backward-element)
+      (should (looking-at "  - sub1"))
+      (goto-line 15)
+      (org-backward-element)
+      (should (looking-at "- item1"))
+      ;; 7.4. At blank-lines before list end: expected to move to top
+      ;; item.
+      (goto-line 14)
+      (org-backward-element))
     (should (looking-at "- item1"))))
 
 (ert-deftest test-org/up-element ()
@@ -5281,21 +5284,23 @@ Outside."
 - item2"
     ;; 4.1. Within an item: move to the item beginning.
     (goto-line 8)
-    (org-up-element)
-    (should (looking-at "  - sub2"))
-    ;; 4.2. At an item in a sub-list: move to parent item.
-    (goto-line 4)
-    (org-up-element)
-    (should (looking-at "- item1"))
-    ;; 4.3. At an item in top list: move to beginning of whole list.
-    (goto-line 10)
-    (org-up-element)
-    (should (looking-at "- item1"))
-    ;; 4.4. Special case.  At very top point: should move to parent of
-    ;;      list.
-    (goto-line 2)
-    (org-up-element)
-    (should (looking-at "\\* Top"))))
+    (org-test-ignore-duplicate
+      (org-up-element)
+      (should (looking-at "  - sub2"))
+      ;; 4.2. At an item in a sub-list: move to parent item.
+      (goto-line 4)
+      (org-up-element)
+      (should (looking-at "- item1"))
+      ;; 4.3. At an item in top list: move to beginning of whole list.
+      (goto-line 10)
+      (org-up-element)
+      (org-test-ignore-duplicate
+        (should (looking-at "- item1")))
+      ;; 4.4. Special case.  At very top point: should move to parent of
+      ;;      list.
+      (goto-line 2)
+      (org-up-element)
+      (should (looking-at "\\* Top")))))
 
 (ert-deftest test-org/down-element ()
   "Test `org-down-element' specifications."
-- 
2.41.0