From 3b38450f7de8bd168d8795728454d9f4db720843 Mon Sep 17 00:00:00 2001 From: Ilya Chernyshov 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 + +;; 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 . +;; +;;; 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 (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