From: Ilya Chernyshov <ichernyshovvv@gmail.com>
To: Ihor Radchenko <yantar92@posteo.net>
Cc: emacs-orgmode <emacs-orgmode@gnu.org>
Subject: Re: [PATCH] testing: Delete duplicate tests
Date: Sat, 11 Nov 2023 15:55:37 +0700 [thread overview]
Message-ID: <87sf5cr7na.fsf@gmail.com> (raw)
In-Reply-To: <878r78ftvs.fsf@localhost>
[-- 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
next prev parent reply other threads:[~2023-11-11 8:56 UTC|newest]
Thread overview: 17+ messages / expand[flat|nested] mbox.gz Atom feed top
2023-07-12 19:22 [PATCH] testing: Delete duplicate tests Ilya Chernyshov
2023-07-13 9:51 ` Ihor Radchenko
2023-08-08 12:44 ` Ihor Radchenko
2023-08-31 6:17 ` Ilya Chernyshov
2023-08-31 6:29 ` Ihor Radchenko
2023-11-08 9:59 ` Ihor Radchenko
2023-11-11 8:55 ` Ilya Chernyshov [this message]
2023-11-16 12:27 ` Ilya Chernyshov
2024-01-16 13:44 ` Ihor Radchenko
2024-01-23 12:03 ` Ilya Chernyshov
2024-01-26 13:24 ` Ihor Radchenko
2024-01-27 5:04 ` Ilya Chernyshov
2024-01-31 12:17 ` Ihor Radchenko
2024-02-09 12:22 ` Ilya Chernyshov
2024-02-09 14:11 ` Ihor Radchenko
2023-07-14 11:50 ` Max Nikulin
2023-07-15 7:56 ` Ihor Radchenko
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.orgmode.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87sf5cr7na.fsf@gmail.com \
--to=ichernyshovvv@gmail.com \
--cc=emacs-orgmode@gnu.org \
--cc=yantar92@posteo.net \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).