;;; 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