diff --git a/idris-tests.el b/idris-tests.el index 47798b24..2d79f416 100644 --- a/idris-tests.el +++ b/idris-tests.el @@ -289,6 +289,36 @@ myReverse xs = revAcc [] xs where (kill-buffer)) (idris-quit))) +(ert-deftest idris-test-warning-overlay () + "Test that `idris-warning-overaly-point' works as expected." + (let* ((buffer (find-file-noselect "test-data/AddClause.idr")) + (warning '("AddClause.idr" (5 7) (5 17) "Some warning message" ())) + (idris-raw-warnings '()) + (idris-process-current-working-directory (file-name-directory (buffer-file-name buffer))) + (expected-position) + (expected-overlay)) + (with-current-buffer buffer + (goto-char (point-min)) + (re-search-forward "data Test") + (setq expected-position (point)) + + (idris-warning-overlay warning) + + ;; Assert that the point position does not change + ;; https://github.com/idris-community/idris2-mode/issues/36 + (should (eq (point) expected-position)) + + ;; Assert side effect + (should (not (null idris-raw-warnings))) + + ;; Assert that overlay was added + (setq expected-overlay (car (overlays-in (point-min) (point-max)))) + (should (not (null expected-overlay))) + (should (string= (overlay-get expected-overlay 'help-echo) + "Some warning message")) + ;; Cleanup + (kill-buffer)))) + (ert-deftest idris-backard-toplevel-navigation-test-2pTac9 () "Test idris-backard-toplevel navigation command." (idris-test-with-temp-buffer diff --git a/idris-warnings.el b/idris-warnings.el index cc9ae10c..d5d709d5 100644 --- a/idris-warnings.el +++ b/idris-warnings.el @@ -94,24 +94,25 @@ is mostly the same as (startline startcolumn)" (buffer (get-file-buffer fullpath))) (when (not (null buffer)) (with-current-buffer buffer - (save-restriction - (widen) ;; Show errors at the proper location in narrowed buffers - (goto-char (point-min)) - (let* ((startp (line-beginning-position startline)) - (endp (line-end-position startline)) - (start (+ startp startcol)) - (end (if (and (= startline endline) (= startcol endcol)) - ;; this is a hack to have warnings reported which point to empty lines - (if (= startp endp) - (progn (goto-char startp) - (insert " ") - (1+ endp)) - endp) - (+ (line-beginning-position endline) endcol))) - (overlay (idris-warning-overlay-at-point startp))) - (if overlay - (idris-warning-merge-overlays overlay message) - (idris-warning-create-overlay start end message)))))))))) + (save-excursion + (save-restriction + (widen) ;; Show errors at the proper location in narrowed buffers + (goto-char (point-min)) + (let* ((startp (line-beginning-position startline)) + (endp (line-end-position startline)) + (start (+ startp startcol)) + (end (if (and (= startline endline) (= startcol endcol)) + ;; a hack to have warnings, which point to empty lines, reported + (if (= startp endp) + (progn (goto-char startp) + (insert " ") + (1+ endp)) + endp) + (+ (line-beginning-position endline) endcol))) + (overlay (idris-warning-overlay-at-point startp))) + (if overlay + (idris-warning-merge-overlays overlay message) + (idris-warning-create-overlay start end message))))))))))) (defun idris-warning-merge-overlays (overlay message) (overlay-put overlay 'help-echo