;;; assess-test.el --- Tests for assess.el -*- lexical-binding: t -*-

;;; Header:

;; The contents of this file are subject to the GPL License, Version 3.0.

;; Copyright (C) 2015, 2016, Phillip Lord, Newcastle University

;; 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 <http://www.gnu.org/licenses/>.


;;; Code:

;; ** Requires

;; #+begin_src emacs-lisp
(require 'load-relative)
(require 'assess)
(require 'cl-lib)

;; #+end_src

;; ** Always failing test

;; For when I need to test my test scripts!

;; #+begin_src emacs-lisp
(ert-deftest assess-fail-for-sure ()
  :expected-result :failed
  (should nil))
;; #+end_src

;; ** Test Extraction

;; Assess supports tests functions which means that we need the ability to test
;; tests. This code simple extracts knowledge from the results of tests.

;; #+begin_src emacs-lisp
(defun assess-test--plist-from-result (result)
  (cl-cdadr
   (ert-test-result-with-condition-condition result)))

(ert-deftest plist-extraction ()
  (let ((tmp
         (assess-test--plist-from-result
          (ert-run-test
           (make-ert-test
            :body
            (lambda ()
              (should
               (eq 1 2))))))))
    (should
     (equal
      tmp
      '(:form (eq 1 2) :value nil)))))

(defun assess-test--explanation-from-result (result)
  (plist-get
   (assess-test--plist-from-result result)
   :explanation))

(ert-deftest explanation-extraction-from-result ()
  "Test that explanation is extractable from failing test.
This also tests the advice on string=."
  (let ((tmp
         (ert-run-test
          (make-ert-test
           :body
           (lambda ()
             (should
              (assess= "1" "2")))))))
    (should
     (assess-test--explanation-from-result tmp))))

(defun assess-test--explanation (f)
  (assess-test--explanation-from-result
   (ert-run-test
    (make-ert-test
     :body f))))

(ert-deftest explanation-extraction ()
  "Test that explanation is extractable from failing test.
This also tests the advice on string=."
  (should
   (assess-test--explanation
    (lambda ()
      (should
       (assess= "1" "2"))))))
;; #+end_src

;; ** Ensure-String testing

;; #+begin_src emacs-lisp
(defvar assess-test-hello.txt
  (relative-expand-file-name "../dev-resources/hello.txt"))

(ert-deftest ensure-string ()
  (should
   (equal "hello"
          (assess-ensure-string "hello")))
  (should
   (with-temp-buffer
     (equal "hello"
            (progn
              (insert "hello")
              (assess-ensure-string (current-buffer))))))
  (should
   (with-temp-buffer
     (equal "hello\n"
            (assess-ensure-string
             (assess-file assess-test-hello.txt)))))
  (should-error
   (assess-ensure-string :hello)))

;; #+end_src

;; ** Compare Buffer to String

;; #+begin_src emacs-lisp

(ert-deftest buffer-string= ()
  (with-temp-buffer
    (insert "hello")
    (should
     (assess=
      (current-buffer)
      "hello")))
  (with-temp-buffer
    (insert "goodbye")
    (should-not
     (assess=
      (current-buffer)
      "hello")))
  (should
   (assess-test--explanation
    (lambda ()
      (with-temp-buffer
        (insert "goodbye")
        (should
         (assess=
          (current-buffer)
          "hello")))))))

;; #+end_src

;; ** Buffer to Buffer

;; #+begin_src emacs-lisp

(ert-deftest buffer= ()
  (assess-with-temp-buffers
      ((a
        (insert "hello"))
       (b
        (insert "hello")))
    (should
     (assess= a b)))
  (assess-with-temp-buffers
      ((a
        (insert "hello"))
       (b
        (insert "goodbye")))
    (should-not
     (assess=
      a b)))
  (should
   (assess-with-temp-buffers
       ((a (insert "hello"))
        (b (insert "goodbye")))
     (assess-test--explanation
      (lambda ()
        (should
         (assess=
          a b)))))))

;; #+end_src

;; ** Buffer to file

;; #+begin_src emacs-lisp
(ert-deftest file-string= ()
  (should
   (assess=
    (assess-file
     assess-test-hello.txt)
    "hello\n"))
  (should-not
   (assess=
    (assess-file assess-test-hello.txt)
    "goodbye"))
  (should
   (assess-test--explanation
    (lambda ()
      (should
       (assess=
        (assess-file
         assess-test-hello.txt)
        "goodbye"))))))


;; #+end_src

;; ** Preserved Buffer List and With Temp Buffers

;; #+begin_src emacs-lisp

(ert-deftest preserved-buffer-list ()
  (should
   (=
    (length (buffer-list))
    (progn
      (assess-with-preserved-buffer-list
       (generate-new-buffer "preserved-buffer-list"))
      (length (buffer-list)))))

  (should
   (=
    (length (buffer-list))
    (condition-case nil
        (assess-with-preserved-buffer-list
         (generate-new-buffer "preserved-buffer-list")
         (signal 'assess-deliberate-error nil))
      (assess-deliberate-error
       (length (buffer-list)))))))

(ert-deftest with-temp-buffers ()
  (should
   (bufferp
    (assess-with-temp-buffers (a) a)))
  (should
   (bufferp
    (assess-with-temp-buffers
        ((a (insert "hello")))
      a)))
  (should
   (equal
    "hello"
    (assess-with-temp-buffers
        ((a (insert "hello")))
      (with-current-buffer
          a
        (buffer-string)))))
  (should
   (=
    (+ 2 (length (buffer-list)))
    (assess-with-temp-buffers (_a _b)
      (length (buffer-list)))))
  (should
   (=
    (length (buffer-list))
    (progn
      (assess-with-temp-buffers (_a _b) nil)
      (length (buffer-list))))))

;; #+end_src

;; ** Open Close files

;; #+begin_src emacs-lisp

(ert-deftest assess-test-related-file ()
  (should
   (file-exists-p
    (assess-make-related-file assess-test-hello.txt)))
  (should
   (assess=
    (assess-file assess-test-hello.txt)
    (assess-file
     (assess-make-related-file assess-test-hello.txt)))))

(ert-deftest assess-test-with-find-file ()
  (should
   (assess-with-find-file
       (assess-make-related-file assess-test-hello.txt)))
  (should-not
   (assess=
    assess-test-hello.txt
    (assess-with-find-file
        (assess-make-related-file assess-test-hello.txt)
      (insert "hello")
      (buffer-string)))))

;; #+end_src

;; ** Creating Files and Directories
;; #+BEGIN_SRC emacs-lisp
(ert-deftest assess-test-create-multiple-files ()
  (assess-with-filesystem '("foo" "bar" "baz")
    (should (file-regular-p "foo"))
    (should (file-regular-p "bar"))
    (should (file-regular-p "baz"))))

(ert-deftest assess-test-create-multiple-directories-and-files ()
  (assess-with-filesystem '("foo/" "bar/" "baz")
    (should (file-directory-p "foo"))
    (should (file-directory-p "bar"))
    (should (file-regular-p "baz"))))

(ert-deftest assess-test-create-nested-directories ()
  (assess-with-filesystem '("foo/bar" "foo/baz/")
    (should (file-regular-p "foo/bar"))
    (should (file-directory-p "foo/baz"))))

(defun assess-test-file-contain-p (file content)
  "Return nil iff FILE does not contain CONTENT."
  (and (file-regular-p file)
       (with-temp-buffer
         (insert-file-contents file)
         (string-match-p content (buffer-string)))))

(ert-deftest assess-test-create-non-empty-file ()
  (assess-with-filesystem '(("foo" "amazing content"))
    (should (assess-test-file-contain-p "foo" "amazing content"))))

(ert-deftest assess-test-create-non-empty-nested-file ()
  (assess-with-filesystem '(("foo/bar" "amazing content"))
    (should (assess-test-file-contain-p "foo/bar" "amazing content"))))

(ert-deftest assess-test-nest-files-recursively ()
  (assess-with-filesystem '(("foo" ("bar" "baz" "bam/"))
                     ("a/b" ("c" "d/"))
                     ("x" (("y" ("z"))
                           ("content" "content")
                           "w")))
    (should (file-regular-p "foo/bar"))
    (should (file-regular-p "foo/baz"))
    (should (file-regular-p "a/b/c"))
    (should (file-regular-p "x/y/z"))
    (should (file-regular-p "x/content"))
    (should (file-regular-p "x/w"))
    (should (assess-test-file-contain-p "x/content" "content"))
    (should (file-directory-p "foo/bam"))
    (should (file-directory-p "a/b/d"))))
;; #+END_SRC
;; ** Indentation Tests

;; #+begin_src emacs-lisp

(ert-deftest assess--test-indent-in-mode ()
  (should
   (assess=
    "(
 (
  (
   (
    ))))"
    (assess--indent-in-mode
     'emacs-lisp-mode
     "(\n(\n(\n(\n))))"))))

(ert-deftest assess--test-indentation= ()
  (should
   (assess-indentation=
    'emacs-lisp-mode
    "(\n(\n(\n(\n))))"
    "(
 (
  (
   (
    ))))"))
  (should-not
   (assess-indentation=
    'emacs-lisp-mode
    "hello"
    "goodbye"))
  (should
   (assess-test--explanation
    (lambda ()
      (should
       (assess-indentation=
        'emacs-lisp-mode
        "hello"
        "goodbye"))))))

(defvar assess-dev-resources
  (relative-expand-file-name "../dev-resources/"))

(defvar assess-dev-elisp-indented
  (concat assess-dev-resources
          "elisp-indented.eld"))

(defvar assess-dev-elisp-unindented
  (concat assess-dev-resources
          "elisp-unindented.eld"))

(ert-deftest assess-test-roundtrip-indentation= ()
  (should
   (assess-roundtrip-indentation=
    'emacs-lisp-mode
    (assess-file assess-dev-elisp-indented)))
  (should-not
   (assess-roundtrip-indentation=
    'emacs-lisp-mode
    (assess-file assess-dev-elisp-unindented))))

(ert-deftest assess-test-roundtrip-indentation-explain= ()
  (should
   (assess-test--explanation
    (lambda ()
      (should
       (assess-roundtrip-indentation=
        'emacs-lisp-mode
        (assess-file assess-dev-elisp-unindented)))))))

(ert-deftest assess-test-file-roundtrip-indentation= ()
  (should
   (let ((auto-mode-alist '((".*" . emacs-lisp-mode))))
     (assess-file-roundtrip-indentation=
      assess-dev-elisp-indented)))
  (should-not
   (let ((auto-mode-alist '((".*" . emacs-lisp-mode))))
     (assess-file-roundtrip-indentation=
      assess-dev-elisp-unindented))))

(ert-deftest assess-test-file-roundtrip-indentation-explain= ()
  ;; let bind auto-mode-alist because ".eld" is not associated with
  ;; emacs-lisp-mode before Emacs-29. Putting the let binding here
  ;; rather than in the lambda is necessary for reasons I don't quite understand
  (should
   (let ((auto-mode-alist '((".*" . emacs-lisp-mode))))
     (assess-test--explanation
      (lambda ()
        (should
         (assess-file-roundtrip-indentation=
          assess-dev-elisp-unindented)))))))

;; ** Face Tests
(defvar assess-dev-elisp-fontified
  (concat assess-dev-resources
          "elisp-fontified.el"))

(ert-deftest assess-test-face-at-simple ()
  (should
   (assess-face-at=
    "(defun x ())"
    'emacs-lisp-mode
    2
    'font-lock-keyword-face))
  (should-not
   (assess-face-at=
    "(not-defun x ())"
    'emacs-lisp-mode
    2
    'font-lock-keyword-face)))

(ert-deftest assess-test-face-at-multiple-positions ()
  (should
   (assess-face-at=
    "(defun x ())
(defun y ())
(defun z ())"
    'emacs-lisp-mode
    '(2 15 28)
    'font-lock-keyword-face))
  (should-not
   (assess-face-at=
    "(defun x ())
(defun y ())
(not-defun z ())"
    'emacs-lisp-mode
    '(2 15 28)
    'font-lock-keyword-face)))

(ert-deftest assess-test-face-at-multiple-faces ()
  (should
   (assess-face-at=
    "(defun x ())"
    'emacs-lisp-mode
    '(2 8)
    '(font-lock-keyword-face font-lock-function-name-face)))
  (should-not
   (assess-face-at=
    "(defun x ())"
    'emacs-lisp-mode
    '(2 10)
    '(font-lock-keyword-face font-lock-function-name-face))))

(ert-deftest assess-test-face-at-with-m-buffer ()
  (should
   (assess-face-at=
    "(defun x ())\n(defun y ())\n(defun z ())"
    'emacs-lisp-mode
    (lambda(buf)
      (m-buffer-match buf "defun"))
    'font-lock-keyword-face)))

(ert-deftest assess-test-face-at-with-strings ()
  (should
   (assess-face-at=
    "(defun x ())\n(defun y ())\n(defun z ())"
    'emacs-lisp-mode
    "defun"
    'font-lock-keyword-face))
  (should
   (assess-face-at=
    "(defun x ())\n(defmacro y ())\n(defun z ())"
    'emacs-lisp-mode
    '("defun" "defmacro" "defun")
    'font-lock-keyword-face)))

(ert-deftest assess-test-file-face-at ()
  (should
   (assess-file-face-at=
    assess-dev-elisp-fontified
    (lambda (buffer)
      (m-buffer-match buffer "defun"))
    'font-lock-keyword-face)))

(ert-deftest assess-discover-test ()
  "Test to see if another test has been defined, which should be auto-discovered"
  (should
   (get 'assess-discover-test-has-this-been-defined 'ert--test)))

;; https://github.com/phillord/assess/issues/4
(ert-deftest issue-4-has-type-face ()
  "Test that no faces are present at point."
  :expected-result
  ;; Emacs 24.2 just does not do this.
  (if (and
       (= emacs-major-version 24)
       (or (= emacs-minor-version 2)
           (= emacs-minor-version 1)))
      :failed :passed)
  (should-not
   (assess-face-at= "foo bar" 'fundamental-mode
                    "bar" 'font-lock-type-face))
  (should-not
   (let ((inhibit-message t))
     (assess-face-at= "def" 'python-mode "def" nil))))

;; https://github.com/phillord/assess/issues/5
(ert-deftest issue-5-test-example ()
  (should-not (assess-indentation= 'fundamental-mode "foo" "bar")))


(ert-deftest strings-with-unequal-properties ()
  (should
   (assess=
    (propertize "hello" 'property 1)
    "hello"))
  (should
   (assess-with-temp-buffers
       ((a (insert ";; Commented")
           (emacs-lisp-mode)
           ;; use instead of font-lock-ensure for emacs 24
           (if (fboundp 'font-lock-ensure)
               (font-lock-ensure)
             (with-no-warnings (font-lock-fontify-buffer))))
        (b (insert ";; Commented")
           (if (fboundp 'font-lock-ensure)
               (font-lock-ensure)
             (with-no-warnings (font-lock-fontify-buffer)))))
     (assess= a b))))
;; #+end_src
