[elpa] externals/relint 1741e2c 09/15: Locate error position in 'concat' forms

[Mattias Engdegård]

branch: externals/relint
commit 1741e2cb6d95773c18d4474844a3e93c3b460472
Author: Mattias Engdegård <address@hidden>
Commit: Mattias Engdegård <address@hidden>

    Locate error position in 'concat' forms
    
    This only works if the string position and everything up to it are in
    string literals.
---
 relint-test.el  | 11 ++++++++---
 relint.el       | 24 +++++++++++++++++++++---
 test/3.expected |  4 ++--
 test/4.expected |  2 +-
 4 files changed, 32 insertions(+), 9 deletions(-)

diff --git a/relint-test.el b/relint-test.el
index 178fa7d..9b835b1 100644
--- a/relint-test.el
+++ b/relint-test.el
@@ -125,14 +125,19 @@ and a path."
     (eval `(relint-test--deftest ,base))))
 
 (ert-deftest relint-buffer ()
-  (let ((buf (get-buffer-create " *relint-test*")))
+  (let ((buf (get-buffer-create " *relint-test*"))
+        (text-quoting-style 'grave))
     (unwind-protect
         (progn
           (with-current-buffer buf
             (emacs-lisp-mode)
-            (insert ";hello\n(looking-at \"broken**regexp\")\n"))
+            (insert ";hello\n(looking-at \"broken**regexp\")\n")
+            (insert "(looking-at (concat \"ab\" \"cdef\" \"[gg]\"))\n"))
           (should (equal
                    (relint-buffer buf)
                    '(("In call to looking-at: Repetition of repetition" 28
-                      "broken**regexp" 7)))))
+                      "broken**regexp" 7)
+                     ("In call to looking-at: Duplicated `g' inside character 
alternative"
+                      73
+                      "abcdef[gg]" 8)))))
       (kill-buffer buf))))
diff --git a/relint.el b/relint.el
index 7e2fb15..fa0d043 100644
--- a/relint.el
+++ b/relint.el
@@ -203,6 +203,25 @@ list indices to follow to target)."
       (goto-char (match-end 0)))
     (point)))
 
+(defun relint--string-pos (pos n)
+  "Position of character N in a string expression at POS,
+or nil if no position could be determined."
+  (save-excursion
+    (goto-char pos)
+    (pcase (read (current-buffer))
+      ((pred stringp) (relint--literal-string-pos pos n))
+      (`(concat . ,args)
+       ;; Find out in which argument the sought position is.
+       (let ((index 1))
+         (while (and args (stringp (car args)) (>= n (length (car args))))
+           (setq n (- n (length (car args))))
+           (setq index (1+ index))
+           (setq args (cdr args)))
+         (and args (stringp (car args))
+              (let ((string-pos
+                     (relint--pos-from-toplevel-pos-path pos (list index))))
+                (relint--literal-string-pos string-pos n))))))))
+
 (defun relint--suppression (pos message)
   "Whether there is a suppression for MESSAGE at POS."
   (save-excursion
@@ -256,9 +275,8 @@ list indices to follow to target)."
 
 (defun relint--report (file toplevel-pos path message &optional str str-pos)
   (let* ((base-pos (relint--pos-from-toplevel-pos-path toplevel-pos path))
-         (pos (if (eq (char-after base-pos) ?\")
-                  (relint--literal-string-pos base-pos str-pos)
-                base-pos)))
+         (pos (or (relint--string-pos base-pos str-pos)
+                  base-pos)))
     (if (relint--suppression pos message)
         (setq relint--suppression-count (1+ relint--suppression-count))
       (funcall relint--report-function file pos message str str-pos)))
diff --git a/test/3.expected b/test/3.expected
index a72d52f..a04ba03 100644
--- a/test/3.expected
+++ b/test/3.expected
@@ -34,10 +34,10 @@
 3.elisp:130:3: In another-bad-regexp-list: Duplicated `7' inside character 
alternative (pos 2)
   "[77]"
    ..^
-3.elisp:141:4: In call to looking-at: Unescaped literal `+' (pos 0)
+3.elisp:141:13: In call to looking-at: Unescaped literal `+' (pos 0)
   "+abcdefgh"
    ^
-3.elisp:157:4: In call to looking-at: Unescaped literal `?' (pos 0)
+3.elisp:157:13: In call to looking-at: Unescaped literal `?' (pos 0)
   "?abc"
    ^
 3.elisp:164:4: In call to looking-at: Duplicated `A' inside character 
alternative (pos 2)
diff --git a/test/4.expected b/test/4.expected
index fc3ca31..9d5488c 100644
--- a/test/4.expected
+++ b/test/4.expected
@@ -28,7 +28,7 @@
 4.elisp:25:15: In call to looking-at: Unescaped literal `*' (pos 0)
   "*ab"
    ^
-4.elisp:26:15: In call to looking-at: Unescaped literal `+' (pos 0)
+4.elisp:26:24: In call to looking-at: Unescaped literal `+' (pos 0)
   "+c"
    ^
 4.elisp:43:15: In call to looking-at: Unescaped literal `^' (pos 1)