diff --git a/fixtures/compile_commands.json b/fixtures/compile_commands.json
index 7ec41e7..8d729a0 100644
--- a/fixtures/compile_commands.json
+++ b/fixtures/compile_commands.json
@@ -1,7 +1,7 @@
[
{
"directory": ".",
- "command": "/usr/bin/c++ sample.cpp",
+ "command": "c++ sample.cpp",
"file": "sample.cpp",
"output": "dummy"
}
diff --git a/fixtures/secondaries.txt b/fixtures/secondaries.txt
new file mode 100644
index 0000000..2679ec8
--- /dev/null
+++ b/fixtures/secondaries.txt
@@ -0,0 +1,9 @@
+
+int divide_seventeen(int param) {
+ if (param == 0) {
+ int a = 0;
+ } else {
+ int b = 0;
+ }
+ return 10 / param;
+}
diff --git a/lsp-sonarlint.el b/lsp-sonarlint.el
index 5a0659e..e2f07b8 100644
--- a/lsp-sonarlint.el
+++ b/lsp-sonarlint.el
@@ -37,6 +37,7 @@
(require 'cus-edit)
(require 'ht)
(require 'shr)
+(require 'hl-line)
(defgroup lsp-sonarlint nil
"SonarLint lsp server group"
@@ -319,7 +320,391 @@ See `lsp-sonarlint-analyze-folder' to see which files are ignored."
("filePath" file)))
utf8-filenames))))))
-(defvar lsp-sonarlint--action-handlers '())
+(defvar lsp-sonarlint--secondary-locations-overlays nil
+ "List of overlays highlighting secondary locations.")
+
+(defface lsp-sonarlint--step-marker '((((class color) (background light))
+ (:weight bold
+ :box (:line-width (2 . -2)
+ :color "pink"
+ :style released-button)
+ :background "dark red"
+ :foreground "white")))
+ "Face used for the little markers on the side of each secondary step.")
+
+(defface lsp-sonarlint-secondary-location-face
+ '((((class color) (background light))
+ (:background "wheat2"))
+ (((class color) (background dark))
+ (:background "gray7"))
+ (t :inverse-video t))
+ "Face used for the secondary locations of a SonarLint issue.")
+
+
+(defface lsp-sonarlint-highlighted-secondary-face
+ '((((class color) (background light))
+ (:box (:line-width -1 :color red)
+ :background "yellow"))
+ (((class color) (background dark))
+ (:box (:line-width -1 :color red)
+ :background "blue3"))
+ (t :inverse-video t))
+ "Face used for the highlighted secondary location of a SonarLint issue.")
+
+(defface lsp-sonarlint-primary-message-face
+ '((t :inherit 'lsp-face-semhl-keyword))
+ "Face used for the primary message in the list of secondary messages.")
+
+(defface lsp-sonarlint-embedded-msg-face
+ '((t :italic t :height 0.8))
+ "Face used for the in-line secondary messages.")
+
+(defun lsp-sonarlint--get-range-positions (range)
+ "Convert the RANGE hash table from SonarLint to a plist with positions."
+ (let ((start-line (1- (ht-get range "startLine")))
+ (start-col (ht-get range "startLineOffset"))
+ (end-line (1- (ht-get range "endLine")))
+ (end-col (ht-get range "endLineOffset")))
+ `(:begin ,(lsp--line-character-to-point start-line start-col)
+ :end ,(lsp--line-character-to-point end-line end-col))))
+
+(defun lsp-sonarlint--make-overlay-between (begin-end-positions)
+ "Create an overlay between BEGIN-END-POSITIONS.
+
+BEGIN-END-POSITIONS is a plist with :begin and :end positions."
+ (let* ((start-pos (plist-get begin-end-positions :begin))
+ (end-pos (plist-get begin-end-positions :end))
+ (overlay (make-overlay start-pos end-pos (current-buffer))))
+ (push overlay lsp-sonarlint--secondary-locations-overlays)
+ overlay))
+
+(defun lsp-sonarlint--add-number-marker (overlay num)
+ "Add a prefix marker NUM to OVERLAY."
+ (overlay-put overlay 'before-string
+ (propertize (number-to-string num)
+ 'face 'lsp-sonarlint--step-marker)))
+
+(defun lsp-sonarlint--make-full-line-overlay (line)
+ "Create an overlay covering entire LINE."
+ (save-excursion
+ (goto-char (point-min))
+ (forward-line (- line 1))
+ (lsp-sonarlint--make-overlay-between `(:begin ,(line-beginning-position)
+ :end ,(line-end-position)))))
+
+(defun lsp-sonarlint--get-column (pos)
+ "Get the column of the point position POS."
+ (save-excursion
+ (goto-char pos)
+ (current-column)))
+
+(defun lsp-sonarlint--procure-overlays-for-secondary-locations (flows)
+ "Create overlays for secondary locations in FLOWS.
+
+Returns a list of plists with the overlay, step number, and message."
+ (let ((step-num 0))
+ (apply
+ #'append
+ (seq-map
+ (lambda (flow)
+ ;; By SonarLint convention in which the execution flow leading to a
+ ;; data-flow issue is listed in reverse order. `seq-reverse' lets us
+ ;; display the execution flow in natural order.
+ (let ((locations (seq-reverse (ht-get flow "locations"))))
+ (seq-map
+ (lambda (location)
+ (setq step-num (1+ step-num))
+ (let* ((range-ht (ht-get location "textRange"))
+ (range (lsp-sonarlint--get-range-positions range-ht))
+ (overlay (lsp-sonarlint--make-overlay-between range))
+ (message (ht-get location "message")))
+ (overlay-put overlay 'face 'lsp-sonarlint-secondary-location-face)
+ (lsp-sonarlint--add-number-marker overlay step-num)
+ `(:overlay ,overlay :step-num ,step-num :message ,message)))
+ locations)))
+ flows))))
+
+(defun lsp-sonarlint--procure-overlay-for-primary-location (action-args)
+ "Parse ACTION-ARGS for the primary location and message and place an overlay."
+ (let* ((message (ht-get action-args "message"))
+ (range-ht (ht-get action-args "textRange"))
+ (range (lsp-sonarlint--get-range-positions range-ht))
+ (overlay (lsp-sonarlint--make-overlay-between range)))
+ `(:overlay ,overlay :message ,message)))
+
+(defconst lsp-sonarlint--secondary-messages-buffer-name "*SonarLint secondary locations*"
+ "Name of the buffer where messages for secondary locations are displayed.")
+
+(defun lsp-sonarlint--remove-secondary-loc-highlights ()
+ "Remove all overlays highlighting secondary locations."
+ (mapc #'delete-overlay lsp-sonarlint--secondary-locations-overlays)
+ (setq lsp-sonarlint--secondary-locations-overlays nil))
+
+(defun lsp-sonarlint--on-quit-window ()
+ "Remove locations' overlays when the secondary-messages window is closed."
+ (when (string-equal (buffer-name) lsp-sonarlint--secondary-messages-buffer-name)
+ (lsp-sonarlint--remove-advices)
+ (lsp-sonarlint--remove-secondary-loc-highlights)))
+
+(defun lsp-sonarlint--remove-advices ()
+ "Remove advices added to `line-move' and `mouse-set-point'."
+ (advice-remove 'line-move #'lsp-sonarlint--on-line-move)
+ (advice-remove 'mouse-set-point #'lsp-sonarlint--on-line-move)
+ (advice-remove 'kill-buffer #'lsp-sonarlint--on-kill-buffer))
+
+(defvar lsp-sonarlint--previously-focused-overlays nil
+ "The list of overlays that was previously focused.")
+
+(defun lsp-sonarlint--unfocus-overlays ()
+ "Unfocus the previously focused overlays."
+ (dolist (ov lsp-sonarlint--previously-focused-overlays)
+ (overlay-put ov 'face 'lsp-sonarlint-secondary-location-face))
+ (setq lsp-sonarlint--previously-focused-overlays nil))
+
+(defun lsp-sonarlint--highlight-target (overlay)
+ "Highlight OVERLAY."
+ (lsp-sonarlint--unfocus-overlays)
+ (overlay-put overlay 'face 'lsp-sonarlint-highlighted-secondary-face)
+ (push overlay lsp-sonarlint--previously-focused-overlays))
+
+(defun lsp-sonarlint--focus-on-target (overlay)
+ "Put point to OVERLAY and make it visible in another window."
+ (when-let ((target-buffer (overlay-buffer overlay))
+ (prev-buffer (current-buffer)))
+ (switch-to-buffer-other-window target-buffer)
+ (goto-char (overlay-start overlay))
+ (hl-line-highlight) ; make sure the line highlighting is updated
+ (switch-to-buffer-other-window prev-buffer)))
+
+(defvar lsp-sonarlint--original-buffer nil
+ "The buffer with code and SonarLint issues.
+
+Useful when exploring secondary locations, which uses an auxiliary buffer.")
+
+(defun lsp-sonarlint--on-line-move (&rest _args)
+ "Highlight the current line in the secondary locations buffer."
+ (when (string-equal (buffer-name) lsp-sonarlint--secondary-messages-buffer-name)
+ (let ((focus-overlay nil))
+ (mapc (lambda (ovl) (when (overlay-get ovl 'focus-location)
+ (setq focus-overlay (overlay-get ovl 'focus-location))))
+ (overlays-at (point)))
+ (when focus-overlay
+ (lsp-sonarlint--focus-on-target focus-overlay)
+ (lsp-sonarlint--highlight-target focus-overlay))))
+ (when (eq (current-buffer) lsp-sonarlint--original-buffer)
+ (when-let* ((focus-overlay (seq-find (lambda (ovl) (overlay-get ovl 'lsp-sonarlint--message-overlay))
+ (overlays-at (- (point) 1) t)))
+ (message-overlay (overlay-get focus-overlay 'lsp-sonarlint--message-overlay)))
+ (lsp-sonarlint--focus-on-target message-overlay)
+ (lsp-sonarlint--highlight-target message-overlay)
+ (hl-line-highlight))))
+
+
+(defun lsp-sonarlint--on-kill-buffer (&rest _args)
+ "Remove sec-locations' highlights and advices when the buffer is killed."
+ (lsp-sonarlint--on-quit-window))
+
+(defun lsp-sonarlint--add-message-entry (loc-message)
+ "Add a new line with message from LOC-MESSAGE.
+
+Should be called on an empty line.
+Returns an overlay placed across the line that has the `focus-location'
+pointing to the `:overlay' from LOC-MESSAGE."
+ (insert (plist-get loc-message :message))
+ (let ((overlay (lsp-sonarlint--make-overlay-between
+ `(:begin ,(line-beginning-position)
+ :end ,(line-end-position))))
+ (focus-overlay (plist-get loc-message :overlay)))
+ (overlay-put overlay 'focus-location focus-overlay)
+ (overlay-put focus-overlay 'lsp-sonarlint--message-overlay overlay)
+ overlay))
+
+(defun lsp-sonarlint--extract-located-messages (locations)
+ "Group messages from LOCATIONS by their coordinates."
+ (let ((line-to-msg (make-hash-table :test #'equal)))
+ (mapc (lambda (location)
+ (let* ((precise-overlay (plist-get location :overlay))
+ (message-offset (lsp-sonarlint--get-column (overlay-start precise-overlay)))
+ (line (line-number-at-pos (overlay-start precise-overlay))))
+ (push `(:offset ,message-offset ,@location)
+ (gethash line line-to-msg))))
+ locations)
+ line-to-msg))
+
+(defun lsp-sonarlint--deduplicate (sorted-list test)
+ "Remove duplicate elements (according to TEST) from sorted SORTED-LIST."
+ (let ((result '())
+ (last-element nil))
+ (dolist (element sorted-list (nreverse result))
+ (unless (funcall test element last-element)
+ (push element result)
+ (setq last-element element)))))
+
+(defun lsp-sonarlint--combine (messages-with-offsets)
+ "Combine MESSAGES-WITH-OFFSETS that don't overlap into single line.
+
+MESSAGES-WITH-OFFSETS must be sorted by offset."
+ (let ((result '())
+ (reversed (reverse messages-with-offsets)))
+ (dolist (msg-off messages-with-offsets (nreverse result))
+ (when-let* ((right-most (car reversed))
+ (right-offset (plist-get right-most :offset))
+ (my-offset (plist-get msg-off :offset))
+ (my-message (plist-get msg-off :message))
+ (gap (- right-offset (+ my-offset (length my-message)))))
+ (unless (< right-offset my-offset) ; this element is already combined
+ (if (<= gap 3) ;; too close or overlap
+ (push msg-off result)
+ (setf (plist-get msg-off :message)
+ (concat my-message
+ (make-string gap ?\s)
+ (plist-get right-most :message)))
+ (pop reversed)
+ (push msg-off result)))))))
+
+(defun lsp-sonarlint--count-digits (num)
+ "Count digits in decimal representation of the NUM integer."
+ (length (number-to-string num)))
+
+(defun lsp-sonarlint--adjust-offsets (messages-with-offsets)
+ "Shift offsets in MESSAGES-WITH-OFFSETS to account for number labels.
+
+MESSAGES-WITH-OFFSETS must be sorted."
+ (let ((accumulated-adjustment 0))
+ (mapcar (lambda (msg-with-offset)
+ (let ((increment
+ (if-let ((step-num (plist-get
+ msg-with-offset
+ :step-num)))
+ (lsp-sonarlint--count-digits step-num)
+ 0)))
+ (setq accumulated-adjustment (+ accumulated-adjustment increment))
+ (setf (plist-get msg-with-offset :offset)
+ (+ accumulated-adjustment
+ (plist-get msg-with-offset :offset)))
+ msg-with-offset))
+ messages-with-offsets)))
+
+(defcustom lsp-sonarlint--scale-inline-msg-offset t
+ "Whether to scale the offset for inline messages (code-lens style).
+
+Usually these messages (including their whitespace offset) are
+printed with smaller font, so they need adjustment to account for
+smaller size of the space character.
+
+- Set to nil if it causes problems.
+- Set to a floating-point number if you want to adjust this factor.
+- If t it will deduce the scaling factor
+ from the `lsp-sonarlint-embedded-msg-face' height."
+ :type '(choice
+ (const :tag "Disable" nil)
+ (integer :tag "Factor")
+ (const :tag "Auto" t)))
+
+(defun lsp-sonarlint--scale-offset (offset)
+ "Adjust OFFSET preserving column position with smaller font."
+ (if lsp-sonarlint--scale-inline-msg-offset
+ (if (numberp lsp-sonarlint--scale-inline-msg-offset)
+ (floor (* lsp-sonarlint--scale-inline-msg-offset offset))
+ (let ((msg-height (face-attribute 'lsp-sonarlint-embedded-msg-face :height nil 'default))
+ (default-height (face-attribute 'default :height)))
+ (/ (* offset
+ default-height)
+ msg-height)))
+ offset))
+
+(defun lsp-sonarlint--scale-msg-lens-offset (msg-with-offset)
+ "Adjust offset in MSG-WITH-OFFSET preserving column with smaller font."
+ (setf (plist-get msg-with-offset :offset)
+ (lsp-sonarlint--scale-offset (plist-get msg-with-offset :offset)))
+ msg-with-offset)
+
+(defun lsp-sonarlint--process-offsets (messages-with-offsets)
+ "Sort, deduplicate, adjust, and combine MESSAGES-WITH-OFFSETS.
+
+Sort them in increasing order, remove duplicate messages with identical offsets,
+adjust offsets to account for the number labels prepended to each location,
+and combine non-overlapping messages toreduce the number of lines."
+ (let* ((sorted (sort messages-with-offsets (lambda (msg-off1 msg-off2)
+ (< (plist-get msg-off1 :offset)
+ (plist-get msg-off2 :offset)))))
+ (deduplicated (lsp-sonarlint--deduplicate
+ sorted
+ (lambda (msg-off1 msg-off2) (and (equal (plist-get msg-off1 :offset)
+ (plist-get msg-off2 :offset))
+ (equal (plist-get msg-off1 :message)
+ (plist-get msg-off2 :message))))))
+ (adjusted (lsp-sonarlint--adjust-offsets deduplicated))
+ ;; Should scale after adjusting, because adjustment is done
+ ;; in terms of the default font
+ (scaled (mapcar #'lsp-sonarlint--scale-msg-lens-offset adjusted)))
+ ;; Should combine after scaling to also scale the potential gaps between
+ ;; combined messages properly
+ (lsp-sonarlint--combine scaled)))
+
+(defun lsp-sonarlint--concat-msg-lines (msg-offsets)
+ "Combine the list of MSG-OFFSETS into a single string."
+ (string-join
+ (mapcar (lambda (msg-offset)
+ (concat (make-string (plist-get msg-offset :offset) ?\s)
+ (plist-get msg-offset :message)))
+ msg-offsets)
+ "\n"))
+
+(defun lsp-sonarlint--add-inline-messages (locations)
+ "Add lens-style in-line messages for LOCATIONS."
+ (maphash (lambda (line messages)
+ (let* ((adjusted-messages
+ (lsp-sonarlint--process-offsets messages))
+ (overlay (lsp-sonarlint--make-full-line-overlay line))
+ (prefix-count (/ (1+ (length adjusted-messages)) 2))
+ (prefix-msgs (seq-take adjusted-messages prefix-count))
+ (postfix-msgs (seq-drop adjusted-messages prefix-count)))
+ (when prefix-msgs
+ (overlay-put overlay 'before-string
+ (propertize (concat (lsp-sonarlint--concat-msg-lines prefix-msgs)
+ "\n")
+ 'face 'lsp-sonarlint-embedded-msg-face)))
+ (when postfix-msgs
+ (overlay-put overlay 'after-string
+ (propertize (concat "\n"
+ (lsp-sonarlint--concat-msg-lines postfix-msgs))
+ 'face 'lsp-sonarlint-embedded-msg-face)))))
+ (lsp-sonarlint--extract-located-messages locations)))
+
+(defun lsp-sonarlint--show-all-locations (command)
+ "Show all secondary locations listed in COMMAND for the focused issue."
+ (lsp-sonarlint--remove-secondary-loc-highlights)
+ (let* ((arguments (seq-first (ht-get command "arguments")))
+ (flows (ht-get arguments "flows")))
+ (let ((locations (lsp-sonarlint--procure-overlays-for-secondary-locations flows))
+ (primary (lsp-sonarlint--procure-overlay-for-primary-location arguments)))
+ (setq lsp-sonarlint--original-buffer (current-buffer))
+ (switch-to-buffer-other-window lsp-sonarlint--secondary-messages-buffer-name)
+ (fundamental-mode)
+ (setq buffer-read-only nil)
+ (erase-buffer)
+
+ (let ((prim-overlay (lsp-sonarlint--add-message-entry primary)))
+ (overlay-put prim-overlay 'face 'lsp-sonarlint-primary-message-face))
+
+ (advice-add 'line-move :after #'lsp-sonarlint--on-line-move)
+ (advice-add 'mouse-set-point :after #'lsp-sonarlint--on-line-move)
+ (advice-add 'kill-buffer :after #'lsp-sonarlint--on-kill-buffer)
+
+ (dolist (location locations)
+ (insert "\n")
+ (let ((overlay (lsp-sonarlint--add-message-entry location)))
+ (lsp-sonarlint--add-number-marker overlay (plist-get location :step-num))))
+ (with-current-buffer lsp-sonarlint--original-buffer
+ (lsp-sonarlint--add-inline-messages (cons primary locations)))
+ (goto-char (point-min))
+ (tabulated-list-mode)
+ (setq-local cursor-type nil))))
+
+(defvar lsp-sonarlint--action-handlers
+ (lsp-ht
+ ("SonarLint.ShowAllLocations" #'lsp-sonarlint--show-all-locations)))
(lsp-register-custom-settings
'(("sonarlint.disableTelemetry" lsp-sonarlint-disable-telemetry)
@@ -401,11 +786,13 @@ See NOTIFICATION-HANDLERS in lsp--client in lsp-mode.")
:multi-root t
:add-on? t
:server-id 'sonarlint
- :action-handlers (ht<-alist lsp-sonarlint--action-handlers)
+ :action-handlers lsp-sonarlint--action-handlers
:initialization-options (lambda ()
- (list
- :productKey "emacs"
- :productName "Emacs"))
+ (list
+ :productKey "emacs"
+ :productName "Emacs"))
+ :after-open-fn (lambda ()
+ (add-hook 'quit-window-hook #'lsp-sonarlint--on-quit-window))
:initialized-fn (lambda (workspace)
(with-lsp-workspace workspace
(lsp--set-configuration
diff --git a/test/lsp-sonarlint-integration-test.el b/test/lsp-sonarlint-integration-test.el
index 722350a..68145a2 100644
--- a/test/lsp-sonarlint-integration-test.el
+++ b/test/lsp-sonarlint-integration-test.el
@@ -26,6 +26,8 @@
(require 'lsp-mode)
(require 'lsp-sonarlint)
+(load-file (expand-file-name "lsp-sonarlint-test-utils.el"
+ (file-name-directory (or load-file-name (buffer-file-name)))))
(defun lsp-sonarlint--wait-for (predicate hook timeout)
"Register PREDICATE to run on HOOK, and wait until it returns t.
@@ -100,18 +102,6 @@ only works for specific textDocument/didOpen:languageId."
"Extract the code of each of ISSUES."
(sort (mapcar (lambda (issue) (gethash "code" issue)) issues) #'string-lessp))
-
-(defun lsp-sonarlint--fixtures-dir ()
- "Directory of the test fixtures for these tests."
- (concat
- (file-name-directory
- (directory-file-name (file-name-directory (symbol-file #'lsp-sonarlint--fixtures-dir))))
- "fixtures/"))
-
-(defun lsp-sonarlint--sample-file (fname)
- "Get the full path of the sample file FNAME."
- (concat (lsp-sonarlint--fixtures-dir) fname))
-
(defun lsp-sonarlint--get-all-issue-codes (sample-filename &optional major-mode)
"Get all SonarLint issue-codes for given SAMPLE-FILENAME.
This functions takes some time to wait for the LSP mode to init
@@ -120,7 +110,7 @@ MAJOR-MODE specifies the major mode enabled to trigger the analysis.
Some analyzers like cfamily require specific major-modes.
If nil, use python-mode by default."
(lsp-sonarlint--exec-with-diags
- (lsp-sonarlint--sample-file sample-filename)
+ (lsp-sonarlint-sample-file sample-filename)
(lambda (diags)
(lsp-sonarlint--get-codes-of-issues diags))
(if major-mode major-mode 'python-mode)))
@@ -208,7 +198,7 @@ If nil, use python-mode by default."
(ert-deftest lsp-sonarlint-display-rule-descr-test ()
"Check whether you can display rule description for a SonarLint issue."
(lsp-sonarlint--exec-with-diags
- (lsp-sonarlint--sample-file "sample.py")
+ (lsp-sonarlint-sample-file "sample.py")
(lambda (diags)
(lsp-sonarlint--go-to-first-diag diags)
(let ((descr-action (lsp-sonarlint--find-descr-action-at-point)))
diff --git a/test/lsp-sonarlint-secondary-locations-test.el b/test/lsp-sonarlint-secondary-locations-test.el
new file mode 100644
index 0000000..fce80d3
--- /dev/null
+++ b/test/lsp-sonarlint-secondary-locations-test.el
@@ -0,0 +1,464 @@
+;;; lsp-sonarlint-secondar-locations-test.el --- Secondary locations tests for Sonarlint LSP client -*- lexical-binding: t; -*-
+;;;
+;; Author: Arseniy Zaostrovnykh
+;; Created: 02 August 2024
+;; License: GPL-3.0-or-later
+;;
+;; 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:
+;; Tests for the display of secondary locations and flow steps for SonarLint issues.
+
+;;; Code:
+
+(require 'lsp-mode)
+(require 'lsp-sonarlint)
+(require 'cl-lib)
+(load-file (expand-file-name "lsp-sonarlint-test-utils.el"
+ (file-name-directory (or load-file-name (buffer-file-name)))))
+
+(defvar lsp-sonarlint-test--file-path (lsp-sonarlint-sample-file "secondaries.txt"))
+(defvar lsp-sonarlint-test--file-uri (concat "file://" lsp-sonarlint-test--file-path))
+
+(defun lsp-sonarlint-test--find-line (file-content line)
+ "Find LINE in the multi-line FILE-CONTENT string."
+ (let ((lines (split-string file-content "\n"))
+ (line-number 1)
+ (found nil))
+ (while (and lines (not found))
+ (when (string= (car lines) line)
+ (setq found line-number))
+ (setq lines (cdr lines))
+ (setq line-number (1+ line-number)))
+ (when (not found)
+ (error "Line %s not found" line))
+ found))
+
+
+(defun lsp-sonarlint-test-range-make (file-content line marker)
+ "Create a single-line diagnostics range summary.
+
+Find LINE in FILE-CONTENT and take that as the line number.
+Set the :from and :to characters to reflect the position of
+`^^^^' in the MARKER.
+
+Example (suppose line #3 of current buffer is \"full line\"):
+
+(lsp-test-range-make (buffer-string)
+ \"full line\"
+ \" ^^^^\")
+
+-> (:line 3 :from 5 :to 8)
+"
+ (let ((line-number (lsp-sonarlint-test--find-line file-content line)))
+ (should-not (null line-number))
+ (should (eq (length marker) (length line)))
+ (should (string-match "^ *\\(\\^+\\) *$" marker))
+ (list :line line-number :from (match-beginning 1) :to (match-end 1))))
+
+(defun lsp-sonarlint-test--line-range->ht (range)
+ "Convert RANGE to a hash table."
+ (lsp-ht ("startLine" (plist-get range :line))
+ ("startLineOffset" (plist-get range :from))
+ ("endLine" (plist-get range :line))
+ ("endLineOffset" (plist-get range :to))
+ ("hash" "")))
+
+(defun lsp-sonarlint-test--secloc-command (primary secondary-flows)
+ "Command for a SonarLint issue with PRIMARY location and SECONDARY-FLOWS.
+
+A location is a plist with message and line range as follows:
+(:message \"Identical code\" :range (:line 29 :from 4 :to 14))
+PRIMARY is a location. SECONDARY-FLOWS is a list of lists of
+locations, each list representing a flow.
+
+Returns a hashtable representing the command as received from
+SonarLint LSP server."
+ (lsp-ht ("title" "Show all locations for issue 'cpp:S3923'")
+ ("command" "SonarLint.ShowAllLocations")
+ ("arguments"
+ (vector
+ (lsp-ht ("fileUri" lsp-sonarlint-test--file-uri)
+ ("message" (plist-get primary :message))
+ ("shouldOpenRuleDescription" t)
+ ("severity" "MAJOR")
+ ("ruleKey" "cpp:S3923")
+ ("flows"
+ (apply
+ #'vector
+ (mapcar
+ (lambda (flow)
+ (lsp-ht
+ ("locations"
+ (apply
+ #'vector
+ (mapcar (lambda (loc)
+ (lsp-ht
+ ("textRange"
+ (lsp-sonarlint-test--line-range->ht
+ (plist-get loc :range)))
+ ("uri" lsp-sonarlint-test--file-uri)
+ ("filePath" lsp-sonarlint-test--file-path)
+ ("message" (plist-get loc :message))
+ ("exists" t)
+ ("codeMatches" t)))
+ flow)))))
+ secondary-flows)))
+ ("textRange"
+ (lsp-sonarlint-test--line-range->ht (plist-get primary :range)))
+ ("codeMatches" nil))))))
+
+(defun lsp-sonarlint-test--overlay-strings (prop-name loc-fun)
+ "Return a list of plists with PROP-NAME and their locs obtained with LOC-FUN."
+ (cl-remove nil (mapcar (lambda (ovl) (if-let ((str-before (overlay-get ovl prop-name)))
+ `(,prop-name ,(substring-no-properties str-before)
+ :pos ,(funcall loc-fun ovl))
+ nil))
+ (overlays-in (point-min) (point-max)))))
+
+(defun lsp-sonarlint-test--buf-string-with-overlay-strings ()
+ "Contents of current buffer interspersed with overlay-attached strings."
+ (let* ((pieces '())
+ (last-pos (point-min))
+ (before-strings (lsp-sonarlint-test--overlay-strings
+ 'before-string #'overlay-start))
+ (after-strings (lsp-sonarlint-test--overlay-strings
+ 'after-string #'overlay-end))
+ (all-strings (sort (append before-strings after-strings)
+ (lambda (str1 str2)
+ (let ((pos1 (plist-get str1 :pos))
+ (pos2 (plist-get str2 :pos)))
+ (or (< pos1 pos2)
+ ;; before-string is inserted before after-string
+ (and (= pos1 pos2)
+ (plist-member str1 'after-string)
+ (not (plist-member str2 'after-string)))))))))
+ (dolist (str all-strings)
+ (let ((pos (plist-get str :pos)))
+ (push (buffer-substring-no-properties last-pos pos) pieces)
+ (when-let ((after-string (plist-get str 'after-string)))
+ (push after-string pieces))
+ (when-let ((before-string (plist-get str 'before-string)))
+ (push before-string pieces))
+ (setq last-pos pos)))
+ (concat (string-join (nreverse pieces))
+ (buffer-substring-no-properties last-pos (point-max)))))
+
+(defun lsp-sonarlint-test--place-overlay (line marker)
+ "Add overlay at LINE covering chars pointed to by MARKER in current buffer."
+ (let* ((range (lsp-sonarlint-test-range-make (buffer-string) line marker))
+ (line (plist-get range :line))
+ (from (plist-get range :from))
+ (to (plist-get range :to)))
+ (save-excursion
+ (goto-char (point-min))
+ (forward-line (- line 1))
+ (make-overlay (+ from (line-beginning-position))
+ (+ to (line-beginning-position))
+ (current-buffer)))))
+
+(ert-deftest lsp-sonarlint-overlay-strings ()
+ "Test `lsp-sonarlint-test--buf-string-with-overlay-strings' on corner cases"
+ (with-temp-buffer
+ (unwind-protect
+ (progn
+ (insert "
+Some string here
+")
+ (overlay-put (lsp-sonarlint-test--place-overlay
+ "Some string here"
+ "^^^^ ")
+ 'before-string
+ "Heho")
+ (overlay-put (lsp-sonarlint-test--place-overlay
+ "Some string here"
+ "^^^^ ")
+ 'after-string
+ "after")
+ (overlay-put (lsp-sonarlint-test--place-overlay
+ "Some string here"
+ " ^ ")
+ 'before-string
+ "bef1")
+ (overlay-put (lsp-sonarlint-test--place-overlay
+ "Some string here"
+ " ^ ")
+ 'after-string
+ "aft1")
+ (overlay-put (lsp-sonarlint-test--place-overlay
+ "Some string here"
+ " ^^^^")
+ 'after-string
+ "
+next str")
+ (should (equal (lsp-sonarlint-test--buf-string-with-overlay-strings)
+ "
+HehoSomeafterbef1 aft1string here
+next str
+"))
+ )
+ (remove-overlays))))
+
+(ert-deftest lsp-sonarlint-display-secondary-messages ()
+ "Test that secondary locations are displayed correctly."
+ (let ((target-file-buf (find-file-noselect lsp-sonarlint-test--file-path))
+ (lsp-sonarlint--scale-inline-msg-offset nil))
+ (with-current-buffer target-file-buf
+ (let* ((primary-range (lsp-sonarlint-test-range-make
+ (buffer-string)
+ " if (param == 0) {"
+ " ^^ "))
+ (primary-loc `(:message "Redundant branching" :range ,primary-range))
+ (secondary-range1
+ (lsp-sonarlint-test-range-make (buffer-string)
+ " int a = 0;"
+ " ^^^^^^^^^^"))
+ (sec-flow1 `((:message "Identical code" :range ,secondary-range1)))
+ (secondary-range2
+ (lsp-sonarlint-test-range-make (buffer-string)
+ " int b = 0;"
+ " ^^^^^^^^^^"))
+ (sec-flow2 `((:message "Identical code" :range ,secondary-range2)))
+ (command (lsp-sonarlint-test--secloc-command
+ primary-loc (list sec-flow1 sec-flow2))))
+ (lsp-sonarlint--show-all-locations command)))
+ (with-current-buffer lsp-sonarlint--secondary-messages-buffer-name
+ (should (equal (lsp-sonarlint-test--buf-string-with-overlay-strings)
+ "Redundant branching
+1Identical code
+2Identical code")))
+ (with-current-buffer target-file-buf
+ (should (equal (lsp-sonarlint-test--buf-string-with-overlay-strings)
+ "
+int divide_seventeen(int param) {
+ Redundant branching
+ if (param == 0) {
+ Identical code
+ 1int a = 0;
+ } else {
+ Identical code
+ 2int b = 0;
+ }
+ return 10 / param;
+}
+")))))
+
+(defun lsp-sonarlint-test--select-message (msg)
+ "Select the step with message MSG in the SonarLint secondary messages buffer."
+ (with-current-buffer lsp-sonarlint--secondary-messages-buffer-name
+ (goto-char (point-min))
+ (search-forward msg)
+ ;; Deliberately using interactive functions here to trigger line-move
+ ;; hooks
+ (previous-line)
+ (forward-char -1) ; Make sure to stay within found string to hit the overlay
+ (next-line)))
+
+(ert-deftest lsp-sonarlint-navigate-to-sec-location ()
+ "Test that point moves to locations of selected messages."
+ (let ((target-file-buf (find-file-noselect lsp-sonarlint-test--file-path))
+ (lsp-sonarlint--scale-inline-msg-offset nil))
+ (with-current-buffer target-file-buf
+ (let* ((primary-range (lsp-sonarlint-test-range-make
+ (buffer-string)
+ " if (param == 0) {"
+ " ^^ "))
+ (primary-loc `(:message "Redundant branching" :range ,primary-range))
+ (secondary-range1
+ (lsp-sonarlint-test-range-make (buffer-string)
+ " int a = 0;"
+ " ^^^^^^^^^^"))
+ (sec-flow1 `((:message "Code A" :range ,secondary-range1)))
+ (secondary-range2
+ (lsp-sonarlint-test-range-make (buffer-string)
+ " int b = 0;"
+ " ^^^^^^^^^^"))
+ (sec-flow2 `((:message "Code B" :range ,secondary-range2)))
+ (command (lsp-sonarlint-test--secloc-command
+ primary-loc (list sec-flow1 sec-flow2))))
+ (lsp-sonarlint--show-all-locations command)))
+ (with-current-buffer target-file-buf
+ (goto-char (point-min)))
+ (lsp-sonarlint-test--select-message "Code A")
+ (with-current-buffer target-file-buf
+ (should (equal (buffer-substring-no-properties (line-beginning-position)
+ (line-end-position))
+ " int a = 0;")))
+ (lsp-sonarlint-test--select-message "Code B")
+ (with-current-buffer target-file-buf
+ (should (equal (buffer-substring-no-properties (line-beginning-position)
+ (line-end-position))
+ " int b = 0;")))))
+
+(ert-deftest lsp-sonarlint-display-execution-flow ()
+ "Test that flow steps are displayed correctly and in order."
+ (let ((target-file-buf (find-file-noselect lsp-sonarlint-test--file-path))
+ (lsp-sonarlint--scale-inline-msg-offset nil))
+ (with-current-buffer target-file-buf
+ (let* ((primary-range (lsp-sonarlint-test-range-make
+ (buffer-string)
+ " return 10 / param;"
+ " ^ "))
+ (primary-loc `(:message "Division by 0" :range ,primary-range))
+ (flow
+ ;; SonarLint sends flow in reverse order
+ (list
+ ;; SonarLint often duplicates primary message in a flow step
+ primary-loc
+ `(:message "Assigning a 0"
+ :range
+ ,(lsp-sonarlint-test-range-make (buffer-string)
+ " int a = 0;"
+ " ^^^^^ "))
+ `(:message "Taking true branch"
+ :range
+ ,(lsp-sonarlint-test-range-make (buffer-string)
+ " if (param == 0) {"
+ " ^^ "))
+ `(:message "Assuming param is 0"
+ :range
+ ,(lsp-sonarlint-test-range-make (buffer-string)
+ " if (param == 0) {"
+ " ^^^^ "))
+ `(:message "Evaluating condition"
+ :range
+ ,(lsp-sonarlint-test-range-make (buffer-string)
+ " if (param == 0) {"
+ " ^^^^^^^^^^ "))))
+ (command (lsp-sonarlint-test--secloc-command
+ primary-loc (list flow))))
+ (lsp-sonarlint--show-all-locations command)))
+ (with-current-buffer lsp-sonarlint--secondary-messages-buffer-name
+ (should (equal (lsp-sonarlint-test--buf-string-with-overlay-strings)
+ "Division by 0
+1Evaluating condition
+2Assuming param is 0
+3Taking true branch
+4Assigning a 0
+5Division by 0")))
+ (with-current-buffer target-file-buf
+ ;; In-line messages appear shifted here because they are rendered
+ ;; with the same font.
+ ;; In the actual buffer these strings have smaller font, so
+ ;; they start closer to the left.
+ (should (equal (lsp-sonarlint-test--buf-string-with-overlay-strings)
+ "
+int divide_seventeen(int param) {
+ Taking true branch
+ Evaluating condition
+ 3if (1param 2== 0) {
+ Assuming param is 0
+ Assigning a 0
+ int 4a = 0;
+ } else {
+ int b = 0;
+ }
+ Division by 0
+ return 10 5/ param;
+}
+")))))
+
+(ert-deftest lsp-sonarlint-add-inline-messages-deduplicate ()
+ "`lsp-sonarlint--add-inline-messages' deduplicates messages."
+ (with-temp-buffer
+ (insert "
+Some long line with words clearly separated
+")
+ (let ((locations
+ (list
+ `(:message "first"
+ :overlay ,(lsp-sonarlint-test--place-overlay
+ "Some long line with words clearly separated"
+ "^^^^ "))
+ `(:message "first"
+ :overlay ,(lsp-sonarlint-test--place-overlay
+ "Some long line with words clearly separated"
+ "^^^^ "))))
+ (lsp-sonarlint--scale-inline-msg-offset nil))
+ (unwind-protect
+ (progn
+ (lsp-sonarlint--add-inline-messages locations)
+ (should (equal (lsp-sonarlint-test--buf-string-with-overlay-strings)
+ "
+first
+Some long line with words clearly separated
+")))
+ (remove-overlays)))))
+
+(ert-deftest lsp-sonarlint-add-inline-messages-both-sides ()
+ "`lsp-sonarlint--add-inline-messages' places messages on both sides of a line."
+ (with-temp-buffer
+ (insert "
+Some long line with words clearly separated
+")
+ (let ((locations
+ (list
+ `(:message "first"
+ :overlay ,(lsp-sonarlint-test--place-overlay
+ "Some long line with words clearly separated"
+ "^^^^ "))
+ `(:message "second"
+ :overlay ,(lsp-sonarlint-test--place-overlay
+ "Some long line with words clearly separated"
+ "^^^^ "))))
+ (lsp-sonarlint--scale-inline-msg-offset nil))
+ (unwind-protect
+ (progn
+ (lsp-sonarlint--add-inline-messages locations)
+ (should (equal (lsp-sonarlint-test--buf-string-with-overlay-strings)
+ "
+second
+Some long line with words clearly separated
+first
+")))
+ (remove-overlays)))))
+
+(ert-deftest lsp-sonarlint-add-inline-messages-combine ()
+ "`lsp-sonarlint--add-inline-messages' combines messages pairwise."
+ (with-temp-buffer
+ (insert "
+Some long line with words clearly separated
+")
+ (let ((locations
+ (list
+ `(:message "first"
+ :overlay ,(lsp-sonarlint-test--place-overlay
+ "Some long line with words clearly separated"
+ "^^^^ "))
+ `(:message "second"
+ :overlay ,(lsp-sonarlint-test--place-overlay
+ "Some long line with words clearly separated"
+ " ^^^^^^^ "))
+ `(:message "third"
+ :overlay ,(lsp-sonarlint-test--place-overlay
+ "Some long line with words clearly separated"
+ " ^^^^ "))
+ `(:message "fourth"
+ :overlay ,(lsp-sonarlint-test--place-overlay
+ "Some long line with words clearly separated"
+ " ^ "))))
+ (lsp-sonarlint--scale-inline-msg-offset nil))
+ (unwind-protect
+ (progn
+ (lsp-sonarlint--add-inline-messages locations)
+ (should (equal (lsp-sonarlint-test--buf-string-with-overlay-strings)
+ "
+first fourth
+Some long line with words clearly separated
+ third second
+")))
+ (remove-overlays)))))
+
+
+;;; lsp-sonarlint-secondar-locations-test.el ends here
diff --git a/test/lsp-sonarlint-test-utils.el b/test/lsp-sonarlint-test-utils.el
new file mode 100644
index 0000000..da62eaf
--- /dev/null
+++ b/test/lsp-sonarlint-test-utils.el
@@ -0,0 +1,38 @@
+;;; integration.el --- Integration tests for Sonarlint LSP client -*- lexical-binding: t; -*-
+;;;
+;; Author: Arseniy Zaostrovnykh
+;; Created: 11 July 2023
+;; License: GPL-3.0-or-later
+;;
+;; 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:
+;; Utility functions for the LSP SonarLint tests.
+
+;;; Code:
+
+(defun lsp-sonarlint-fixtures-dir ()
+ "Directory of the test fixtures for these tests."
+ (concat
+ (file-name-directory
+ (directory-file-name (file-name-directory (symbol-file #'lsp-sonarlint-fixtures-dir))))
+ "fixtures/"))
+
+(defun lsp-sonarlint-sample-file (fname)
+ "Get the full path of the sample file FNAME."
+ (concat (lsp-sonarlint-fixtures-dir) fname))
+
+(provide 'lsp-sonarlint-test-utils)
+
+;;; lsp-sonarlint-test-utils.el ends here