;;; find-definition-test.el --- Test suite for find-definition.el -*- lexical-binding: t -*-

;; Copyright (C) 2014  Jorgen Schaefer <contact@jorgenschaefer.de>

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

;;; Commentary:

;;; Code:

(require 'ert)
(require 'find-definition)


(defmacro find-definition-with-temp-file (variable &rest body)
  "Create a temporary file, bind it to VARIABLE, and evaluated BODY.

Delete the file after BODY finishes."
  (declare (indent 1))
  `(let ((,variable (make-temp-file "find-definition-test-")))
     (unwind-protect
         (progn ,@body)
       (delete-file ,variable))))

;;;;;;;;;;;;;;;;;;;
;;; find-definition

(ert-deftest find-definition ()
  ;; It should go to the definition if there is exactly one.
  (find-definition-with-temp-file filename
    (with-temp-file filename
      (insert "Hello\n"
              "World\n"))
    (let ((find-definition-function (lambda ()
                                      (list (list filename 2 3)))))

      (find-definition)

      (should (equal (buffer-file-name) filename))
      (should (looking-at "ld")))
    (kill-buffer))

  ;; If the backend function can't find a definition for the thing at
  ;; point, find-definition should prompt the user for a symbol
  ;; completed by a backend-provided completion table. This symbol
  ;; then is passed to a backend function to get the location.
  (find-definition-with-temp-file filename
    (cl-letf* ( ;; User function definitions
               (find-definition-function (lambda ()
                                           nil))
               (find-definition-identifier-completion-table 'test-table)
               (fdsf-identifier nil)
               (find-definition-identifier-function
                (lambda (sym)
                  (setq fdsf-identifier sym)
                  (list (list filename 1 0))))
               ;; Mocking
               (cr-collection nil)
               ((symbol-function 'completing-read)
                (lambda (prompt collection &rest args)
                  (setq cr-collection collection)
                  "test-symbol")))

      (find-definition)

      (should (equal cr-collection 'test-table))
      (should (equal fdsf-identifier "test-symbol"))
      (should (equal (buffer-file-name) filename))))

  ;; Do the same with a prefix argument.
  (find-definition-with-temp-file filename
    (cl-letf* ( ;; User function definitions
               (find-definition-function (lambda ()
                                           (error "Should not be called")))
               (find-definition-identifier-completion-table 'test-table)
               (find-definition-identifier-function
                (lambda (sym)
                  (list (list filename 1 0))))
               ;; Mocking
               (cr-collection nil)
               ((symbol-function 'completing-read)
                (lambda (prompt collection &rest args)
                  (setq cr-collection collection)
                  "test-symbol")))

      (find-definition '(4))

      (should (equal cr-collection 'test-table))))

  ;; Without a completion table and no identifier at point, the
  ;; function should throw an error.
  (cl-letf* ((find-definition-function (lambda ()
                                         nil))
             (find-definition-identifier-completion-table nil)
             (find-definition-identifier-function nil))

    (should-error
     (find-definition)))

  ;; Without a completion table and a prefix argument, the function
  ;; should throw an error as well
  (cl-letf* ((find-definition-function (lambda ()
                                         (error "Should not be called")))
             (find-definition-identifier-completion-table nil)
             (find-definition-identifier-function nil))

    (should-error
     (find-definition '(4))))

  ;; It should pop up a selection dialog if there is more than one
  ;; definition.
  (find-definition-with-temp-file filename
    (with-temp-file filename
      (insert "Hello\n"
              "World\n"))
    (let ((find-definition-function (lambda ()
                                      (list (list filename 1)
                                            (list filename 2)))))

      (find-definition)

      (should (equal (buffer-name) "*Definitions*"))
      (should (eq major-mode 'compilation-mode))))
  )

;;;;;;;;;;;;;;;;;;;;;;;;
;;; find-definition-uses

;; - find-definition-uses should go the use if there is exactly one.
;; - find-definition-uses should pop up a selection dialog if there is
;;   more than one use.
;; - find-definition-uses should prompt for name if there is no definition.
;; - find-definition-uses should prompt for name with prefix argument.

;; - Provide a new function, etags-find-definition

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; find-definition-goto-last-position

(ert-deftest find-definition-goto-last-position ()
  ;; It should move to the last position in the same buffer
  (with-temp-buffer
    (let* ((find-definition-marker-ring (make-ring 5))
           (start (point))
           (marker (make-marker)))
      (set-marker marker start)
      (ring-insert find-definition-marker-ring marker)
      (insert "Bla bla\n")
      (should (not (= (point) start)))
      (find-definition-goto-last-position)
      (should (= (point) start))))

  ;; It should move to the last position in another buffer
  (with-temp-buffer
    (let* ((find-definition-marker-ring (make-ring 5))
           (start (point))
           (start-buffer (current-buffer))
           (marker (make-marker)))
      (set-marker marker start start-buffer)
      (ring-insert find-definition-marker-ring marker)
      (with-temp-buffer
        (find-definition-goto-last-position)
        (should (equal (current-buffer) start-buffer))
        (should (= (point) start)))))

  ;; It should should be interactive
  (should (interactive-form 'find-definition-goto-last-position))

  ;; It should raise an error when the marker ring is empty
  (let ((find-definition-marker-ring (make-ring 1)))
    (should-error (find-definition-goto-last-position)))

  ;; It should raise an error if the original buffer is deleted
  (let* ((find-definition-marker-ring (make-ring 5))
         (marker (make-marker)))
    (with-temp-buffer
      (set-marker marker (point))
      (ring-insert find-definition-marker-ring marker))
    (should-error
     (find-definition-goto-last-position)))

  ;; It should reset the marker
  ;;
  ;; Why? This is copied from pop-to-mark, but why would this be
  ;; needed?
  (let* ((find-definition-marker-ring (make-ring 5))
         (marker (make-marker)))
    (with-temp-buffer
      (set-marker marker (point))
      (ring-insert find-definition-marker-ring marker)
      (find-definition-goto-last-position)
      (should (null (marker-position marker)))
      (should (null (marker-buffer marker)))))
  )

(provide 'find-definition-test)
;;; find-definition-test.el ends here