[elpa] externals/relint bc7f295 5/7: Better position accuracy in various lists of regexps

[Mattias Engdegård]

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

    Better position accuracy in various lists of regexps
---
 relint.el        | 173 ++++++++++++++++++++++++++++++++++++++++---------------
 test/1.expected  |  80 ++++++++++++-------------
 test/10.elisp    |  19 ++++++
 test/10.expected |  30 ++++++++++
 test/3.expected  |  16 ++---
 test/9.expected  |   6 +-
 6 files changed, 225 insertions(+), 99 deletions(-)

diff --git a/relint.el b/relint.el
index f231f28..47d9be2 100644
--- a/relint.el
+++ b/relint.el
@@ -146,7 +146,10 @@ and PATH is (3 0 1 2), then the returned position is right 
before G."
             (forward-sexp)
             (setq skip (1- skip)))))
       (setq p (cdr p))))
-  (relint--skip-whitespace))
+  (relint--skip-whitespace)
+  (when (looking-at (rx "."))
+    (forward-char)
+    (relint--skip-whitespace)))
 
 (defun relint--pos-from-start-pos-path (start-pos path)
   "Compute position from START-POS and PATH (reversed list of
@@ -1014,11 +1017,64 @@ evaluated are nil."
    (t
     (relint--eval-or-nil form))))
 
-(defun relint--get-list (form)
-  "Convert something to a list, or nil."
-  (let ((val (relint--eval-list form)))
-    (and (consp val) val)))
-  
+(defun relint--eval-list-iter (fun form path)
+  "Evaluate FORM to a list and call FUN for each non-nil element
+with (ELEM ELEM-PATH LITERAL) as arguments. ELEM-PATH is the best
+approximation to a path to ELEM and has the same base position as
+PATH; LITERAL is true if ELEM-PATH leads to a literal ELEM in the
+source."
+  (pcase form
+    (`(quote ,arg)
+     (when (consp arg)
+       (let ((i 0)
+             (p (cons 1 path)))
+         (dolist (elem arg)
+           (when elem
+             (funcall fun elem (cons i p) t))
+           (setq i (1+ i))))))
+    (`(list . ,args)
+     (let ((i 1))
+       (dolist (expr args)
+         (pcase expr
+           ((pred stringp)
+            (funcall fun expr (cons i path) t))
+           (`(quote ,elem)
+            (when elem
+              (funcall fun elem (cons 1 (cons i path)) t)))
+           (_ (let ((elem (relint--eval-or-nil expr)))
+                (when elem
+                  (funcall fun elem (cons i path) nil)))))
+         (setq i (1+ i)))))
+    (`(append . ,args)
+     (let ((i 1))
+       (dolist (arg args)
+         (relint--eval-list-iter fun arg (cons i path))
+         (setq i (1+ i)))))
+    (`(\` ,args)
+     (when (consp args)
+       (let ((i 0))
+         (let ((p0 (cons 1 path)))
+           (dolist (arg args)
+             (let* ((expanded (relint--eval-or-nil (list '\` arg)))
+                    (values (if (and (consp arg)
+                                     (eq (car arg) '\,@))
+                                expanded
+                              (list expanded)))
+                    (p (cons i p0)))
+               (dolist (elem values)
+                 (when elem
+                   (funcall fun elem p (equal arg expanded)))))
+             (setq i (1+ i)))))))
+    (`(eval-when-compile ,expr)
+     (relint--eval-list-iter fun expr (cons 1 path)))
+    (_
+     ;; Fall back on `relint--eval-list', giving up on
+     ;; element-specific source position.
+     (let ((expr (relint--eval-list form)))
+       (when (consp expr)
+         (dolist (elem expr)
+           (funcall fun elem path nil)))))))
+
 (defun relint--get-string (form)
   "Convert something to a string, or nil."
   (let ((val (relint--eval-or-nil form)))
@@ -1031,72 +1087,93 @@ evaluated are nil."
 
 (defun relint--check-list (form name file pos path)
   "Check a list of regexps."
-  ;; Don't use dolist -- mustn't crash on improper lists.
-  (let ((l (relint--get-list form)))
-    (while (consp l)
-      (when (stringp (car l))
-        (relint--check-re-string (car l) name file pos path))
-      (setq l (cdr l)))))
+  (relint--eval-list-iter
+   (lambda (elem elem-path _literal)
+     (when (stringp elem)
+       (relint--check-re-string elem name file pos elem-path)))
+   form path))
 
 (defun relint--check-list-any (form name file pos path)
   "Check a list of regexps or conses whose car is a regexp."
-  (dolist (elem (relint--get-list form))
-    (cond
-     ((stringp elem)
-      (relint--check-re-string elem name file pos path))
-     ((and (consp elem)
-           (stringp (car elem)))
-      (relint--check-re-string (car elem) name file pos path)))))
+  (relint--eval-list-iter
+   (lambda (elem elem-path literal)
+     (cond
+      ((stringp elem)
+       (relint--check-re-string elem name file pos elem-path))
+      ((and (consp elem)
+            (stringp (car elem)))
+       (relint--check-re-string (car elem) name file pos
+                                (if literal (cons 0 elem-path) elem-path)))))
+   form path))
 
 (defun relint--check-alist-any (form name file pos path)
   "Check an alist whose cars or cdrs may be regexps."
-  (dolist (elem (relint--get-list form))
-    (when (consp elem)
-      (when (stringp (car elem))
-        (relint--check-re-string (car elem) name file pos path))
-      (when (stringp (cdr elem))
-        (relint--check-re-string (cdr elem) name file pos path)))))
+  (relint--eval-list-iter
+   (lambda (elem elem-path literal)
+     (when (consp elem)
+       (when (stringp (car elem))
+         (relint--check-re-string (car elem) name file pos
+                                  (if literal (cons 0 elem-path) elem-path)))
+       (when (stringp (cdr elem))
+         (relint--check-re-string (cdr elem) name file pos
+                                  (if literal (cons 1 elem-path) elem-path)))))
+   form path))
 
 (defun relint--check-alist-cdr (form name file pos path)
   "Check an alist whose cdrs are regexps."
-  (dolist (elem (relint--get-list form))
-    (when (and (consp elem)
-               (stringp (cdr elem)))
-      (relint--check-re-string (cdr elem) name file pos path))))
+  (relint--eval-list-iter
+   (lambda (elem elem-path literal)
+     (when (and (consp elem)
+                (stringp (cdr elem)))
+       (relint--check-re-string (cdr elem) name file pos
+                                (if literal (cons 1 elem-path) elem-path))))
+   form path))
 
 (defun relint--check-font-lock-keywords (form name file pos path)
   "Check a font-lock-keywords list.  A regexp can be found in an element,
 or in the car of an element."
-  (dolist (elem (relint--get-list form))
+  (relint--eval-list-iter
+   (lambda (elem elem-path literal)
     (cond
      ((stringp elem)
-      (relint--check-re-string elem name file pos path))
+      (relint--check-re-string elem name file pos elem-path))
      ((and (consp elem)
            (stringp (car elem)))
       (let* ((tag (and (symbolp (cdr elem)) (cdr elem)))
-             (ident (if tag (format "%s (%s)" name tag) name)))
-        (relint--check-re-string (car elem) ident file pos path))))))
+             (ident (if tag (format "%s (%s)" name tag) name))
+             (p (if literal
+                    (cons 0 elem-path)
+                  elem-path)))
+        (relint--check-re-string (car elem) ident file pos p)))))
+   form path))
 
 (defun relint--check-compilation-error-regexp-alist-alist (form name
                                                            file pos path)
-  (dolist (elem (relint--get-list form))
-    (if (cadr elem)
-        (relint--check-re-string
-         (cadr elem)
-         (format "%s (%s)" name (car elem))
-         file pos path))))
+  (relint--eval-list-iter
+   (lambda (elem elem-path literal)
+     (when (cadr elem)
+       (relint--check-re-string
+        (cadr elem)
+        (format "%s (%s)" name (car elem))
+        file pos (if literal (cons 1 elem-path) elem-path))))
+   form path))
 
 (defun relint--check-rules-list (form name file pos path)
   "Check a variable on `align-mode-rules-list' format"
-  (dolist (rule (relint--get-list form))
-    (when (and (consp rule)
-               (symbolp (car rule)))
-      (let* ((rule-name (car rule))
-             (re-form (cdr (assq 'regexp (cdr rule))))
-             (re (relint--get-string re-form)))
-        (when (stringp re)
-          (relint--check-re-string 
-           re (format "%s (%s)" name rule-name) file pos path))))))
+  (relint--eval-list-iter
+   (lambda (rule rule-path literal)
+     (when (and (consp rule)
+                (symbolp (car rule)))
+       (let ((rule-name (car rule))
+             (i 1))
+         (dolist (clause (cdr rule))
+           (when (and (consp clause) (eq (car clause) 'regexp)
+                      (stringp (cdr clause)))
+             (relint--check-re-string 
+              (cdr clause) (format "%s (%s)" name rule-name) file pos
+              (if literal (cons 1 (cons i rule-path)) rule-path)))
+           (setq i (1+ i))))))
+   form path))
 
 (defconst relint--known-regexp-variables
   '(page-delimiter paragraph-separate paragraph-start
diff --git a/test/1.expected b/test/1.expected
index 9f84ffe..8d1e997 100644
--- a/test/1.expected
+++ b/test/1.expected
@@ -10,97 +10,97 @@
 1.elisp:9:26: In bad-pattern: Duplicated `A' inside character alternative (pos 
2)
   "[AA]"
    ..^
-1.elisp:11:23: In bad-regexps: Unescaped literal `+' (pos 0)
+1.elisp:11:30: In bad-regexps: Unescaped literal `+' (pos 0)
   "+a"
    ^
-1.elisp:12:23: In bad-regexes: Unescaped literal `+' (pos 0)
+1.elisp:12:30: In bad-regexes: Unescaped literal `+' (pos 0)
   "+b"
    ^
-1.elisp:13:27: In bad-regexp-list: Unescaped literal `+' (pos 0)
+1.elisp:13:34: In bad-regexp-list: Unescaped literal `+' (pos 0)
   "+c"
    ^
-1.elisp:14:26: In bad-regex-list: Unescaped literal `+' (pos 0)
+1.elisp:14:33: In bad-regex-list: Unescaped literal `+' (pos 0)
   "+d"
    ^
-1.elisp:15:23: In bad-re-list: Unescaped literal `+' (pos 0)
+1.elisp:15:30: In bad-re-list: Unescaped literal `+' (pos 0)
   "+e"
    ^
-1.elisp:17:28: In bad-regexp-alist: Unescaped literal `*' (pos 0)
+1.elisp:17:36: In bad-regexp-alist: Unescaped literal `*' (pos 0)
   "**"
    ^
-1.elisp:17:28: In bad-regexp-alist: Unescaped literal `?' (pos 0)
+1.elisp:17:43: In bad-regexp-alist: Unescaped literal `?' (pos 0)
   "??"
    ^
-1.elisp:17:28: In bad-regexp-alist: Unescaped literal `^' (pos 1)
+1.elisp:17:55: In bad-regexp-alist: Unescaped literal `^' (pos 1)
   ".^"
    .^
-1.elisp:17:28: In bad-regexp-alist: Unescaped literal `$' (pos 0)
+1.elisp:17:61: In bad-regexp-alist: Unescaped literal `$' (pos 0)
   "$."
    ^
-1.elisp:18:27: In bad-regex-alist: Unescaped literal `*' (pos 0)
+1.elisp:18:35: In bad-regex-alist: Unescaped literal `*' (pos 0)
   "**"
    ^
-1.elisp:18:27: In bad-regex-alist: Unescaped literal `?' (pos 0)
+1.elisp:18:42: In bad-regex-alist: Unescaped literal `?' (pos 0)
   "??"
    ^
-1.elisp:18:27: In bad-regex-alist: Unescaped literal `^' (pos 1)
+1.elisp:18:54: In bad-regex-alist: Unescaped literal `^' (pos 1)
   ".^"
    .^
-1.elisp:18:27: In bad-regex-alist: Unescaped literal `$' (pos 0)
+1.elisp:18:60: In bad-regex-alist: Unescaped literal `$' (pos 0)
   "$."
    ^
-1.elisp:19:24: In bad-re-alist: Unescaped literal `*' (pos 0)
+1.elisp:19:32: In bad-re-alist: Unescaped literal `*' (pos 0)
   "**"
    ^
-1.elisp:19:24: In bad-re-alist: Unescaped literal `?' (pos 0)
+1.elisp:19:39: In bad-re-alist: Unescaped literal `?' (pos 0)
   "??"
    ^
-1.elisp:19:24: In bad-re-alist: Unescaped literal `^' (pos 1)
+1.elisp:19:51: In bad-re-alist: Unescaped literal `^' (pos 1)
   ".^"
    .^
-1.elisp:19:24: In bad-re-alist: Unescaped literal `$' (pos 0)
+1.elisp:19:57: In bad-re-alist: Unescaped literal `$' (pos 0)
   "$."
    ^
-1.elisp:20:29: In bad-pattern-alist: Unescaped literal `*' (pos 0)
+1.elisp:20:37: In bad-pattern-alist: Unescaped literal `*' (pos 0)
   "**"
    ^
-1.elisp:20:29: In bad-pattern-alist: Unescaped literal `?' (pos 0)
+1.elisp:20:44: In bad-pattern-alist: Unescaped literal `?' (pos 0)
   "??"
    ^
-1.elisp:20:29: In bad-pattern-alist: Unescaped literal `^' (pos 1)
+1.elisp:20:56: In bad-pattern-alist: Unescaped literal `^' (pos 1)
   ".^"
    .^
-1.elisp:20:29: In bad-pattern-alist: Unescaped literal `$' (pos 0)
+1.elisp:20:62: In bad-pattern-alist: Unescaped literal `$' (pos 0)
   "$."
    ^
-1.elisp:22:26: In bad-mode-alist: Unescaped literal `?' (pos 0)
+1.elisp:22:41: In bad-mode-alist: Unescaped literal `?' (pos 0)
   "??"
    ^
-1.elisp:22:26: In bad-mode-alist: Unescaped literal `^' (pos 1)
+1.elisp:22:53: In bad-mode-alist: Unescaped literal `^' (pos 1)
   ".^"
    .^
-1.elisp:24:26: In bad-rules-list (eins): Unescaped literal `$' (pos 0)
+1.elisp:26:40: In bad-rules-list (eins): Unescaped literal `$' (pos 0)
   "$$"
    ^
-1.elisp:24:26: In bad-rules-list (zwei): Reversed range `a-Z' matches nothing 
(pos 1)
+1.elisp:29:41: In bad-rules-list (zwei): Reversed range `a-Z' matches nothing 
(pos 1)
   "[a-Z]"
    .^
-1.elisp:31:34: In bad-font-lock-keywords (tag): Duplicated `x' inside 
character alternative (pos 2)
+1.elisp:31:40: In bad-font-lock-keywords (tag): Duplicated `x' inside 
character alternative (pos 2)
   "[xx]"
    ..^
-1.elisp:31:34: In bad-font-lock-keywords: Duplicated `y' inside character 
alternative (pos 2)
+1.elisp:31:54: In bad-font-lock-keywords: Duplicated `y' inside character 
alternative (pos 2)
   "[yy]"
    ..^
-1.elisp:32:39: In more-font-lock-keywords-bad (tag): Duplicated `u' inside 
character alternative (pos 2)
+1.elisp:32:45: In more-font-lock-keywords-bad (tag): Duplicated `u' inside 
character alternative (pos 2)
   "[uu]"
    ..^
-1.elisp:32:39: In more-font-lock-keywords-bad: Duplicated `v' inside character 
alternative (pos 2)
+1.elisp:32:59: In more-font-lock-keywords-bad: Duplicated `v' inside character 
alternative (pos 2)
   "[vv]"
    ..^
-1.elisp:33:33: In font-lock-add-keywords (tag): Duplicated `s' inside 
character alternative (pos 2)
+1.elisp:33:39: In font-lock-add-keywords (tag): Duplicated `s' inside 
character alternative (pos 2)
   "[ss]"
    ..^
-1.elisp:33:33: In font-lock-add-keywords: Duplicated `t' inside character 
alternative (pos 2)
+1.elisp:33:53: In font-lock-add-keywords: Duplicated `t' inside character 
alternative (pos 2)
   "[tt]"
    ..^
 1.elisp:36:23: In bad-var-1: Unescaped literal `^' (pos 1)
@@ -127,30 +127,30 @@
 1.elisp:57:9: In bad-custom-3-regexp: Unescaped literal `^' (pos 2)
   "^c^"
    ..^
-1.elisp:64:12: In bad-custom-4-regexp: Unescaped literal `+' (pos 0)
+1.elisp:64:19: In bad-custom-4-regexp: Unescaped literal `+' (pos 0)
   "+b"
    ^
-1.elisp:65:25: In bad-custom-5: Unescaped literal `^' (pos 2)
+1.elisp:65:44: In bad-custom-5: Unescaped literal `^' (pos 2)
   "^x^"
    ..^
-1.elisp:69:25: error: In bad-custom-6: No character class `[:bah:]'
+1.elisp:69:53: error: In bad-custom-6: No character class `[:bah:]'
   "[[:bah:]]"
-1.elisp:73:25: In bad-custom-7: Duplicated `a' inside character alternative 
(pos 2)
+1.elisp:73:35: In bad-custom-7: Duplicated `a' inside character alternative 
(pos 2)
   "[aa]"
    ..^
-1.elisp:80:3: In compilation-error-regexp-alist-alist (aa): Unescaped literal 
`^' (pos 1)
+1.elisp:80:11: In compilation-error-regexp-alist-alist (aa): Unescaped literal 
`^' (pos 1)
   "a^a"
    .^
-1.elisp:80:3: In compilation-error-regexp-alist-alist (bb): Unescaped literal 
`$' (pos 1)
+1.elisp:81:11: In compilation-error-regexp-alist-alist (bb): Unescaped literal 
`$' (pos 1)
   "b$b"
    .^
-1.elisp:86:3: In define-generic-mode my-mode: Unescaped literal `^' (pos 1)
+1.elisp:86:8: In define-generic-mode my-mode: Unescaped literal `^' (pos 1)
   "1^"
    .^
-1.elisp:86:3: In define-generic-mode my-mode: Unescaped literal `^' (pos 1)
+1.elisp:87:8: In define-generic-mode my-mode: Unescaped literal `^' (pos 1)
   "2^"
    .^
-1.elisp:88:3: In define-generic-mode my-mode: Repetition of repetition (pos 2)
+1.elisp:88:12: In define-generic-mode my-mode: Repetition of repetition (pos 2)
   "b++"
    ..^
 1.elisp:94:6: In call to syntax-propertize-rules: Unescaped literal `$' (pos 0)
diff --git a/test/10.elisp b/test/10.elisp
new file mode 100644
index 0000000..fe3f396
--- /dev/null
+++ b/test/10.elisp
@@ -0,0 +1,19 @@
+;;; Relint test file 10          -*- emacs-lisp -*-
+
+;; Test error position in lists
+
+(defconst test-1-regexp-list
+  (append
+   (list "1" "[aa]")
+   (list "2" "3" "[bb]")))
+
+(defconst test-2-regexp-alist
+  `((c . "[cc]")
+    ,(cons 'd "[dd]")
+    (e . ,(concat "[e" "e]"))
+    ,@(list '(f . "[ff]") '(g . "[gg]"))
+    (i . "[hh]")))
+
+(defconst test-3-regexp-alist
+  (list
+   '("[ii]" . "[jj]")))
diff --git a/test/10.expected b/test/10.expected
new file mode 100644
index 0000000..4f08705
--- /dev/null
+++ b/test/10.expected
@@ -0,0 +1,30 @@
+10.elisp:7:17: In test-1-regexp-list: Duplicated `a' inside character 
alternative (pos 2)
+  "[aa]"
+   ..^
+10.elisp:8:21: In test-1-regexp-list: Duplicated `b' inside character 
alternative (pos 2)
+  "[bb]"
+   ..^
+10.elisp:11:13: In test-2-regexp-alist: Duplicated `c' inside character 
alternative (pos 2)
+  "[cc]"
+   ..^
+10.elisp:12:5: In test-2-regexp-alist: Duplicated `d' inside character 
alternative (pos 2)
+  "[dd]"
+   ..^
+10.elisp:13:5: In test-2-regexp-alist: Duplicated `e' inside character 
alternative (pos 2)
+  "[ee]"
+   ..^
+10.elisp:14:5: In test-2-regexp-alist: Duplicated `f' inside character 
alternative (pos 2)
+  "[ff]"
+   ..^
+10.elisp:14:5: In test-2-regexp-alist: Duplicated `g' inside character 
alternative (pos 2)
+  "[gg]"
+   ..^
+10.elisp:15:13: In test-2-regexp-alist: Duplicated `h' inside character 
alternative (pos 2)
+  "[hh]"
+   ..^
+10.elisp:19:9: In test-3-regexp-alist: Duplicated `i' inside character 
alternative (pos 2)
+  "[ii]"
+   ..^
+10.elisp:19:18: In test-3-regexp-alist: Duplicated `j' inside character 
alternative (pos 2)
+  "[jj]"
+   ..^
diff --git a/test/3.expected b/test/3.expected
index a04ba03..2a5d99c 100644
--- a/test/3.expected
+++ b/test/3.expected
@@ -10,28 +10,28 @@
 3.elisp:94:4: In call to looking-at: Unescaped literal `^' (pos 2)
   "^m^"
    ..^
-3.elisp:130:3: In another-bad-regexp-list: Duplicated `1' inside character 
alternative (pos 2)
+3.elisp:131:4: In another-bad-regexp-list: Duplicated `1' inside character 
alternative (pos 2)
   "[11]"
    ..^
-3.elisp:130:3: In another-bad-regexp-list: Duplicated `2' inside character 
alternative (pos 2)
+3.elisp:132:4: In another-bad-regexp-list: Duplicated `2' inside character 
alternative (pos 2)
   "[22]"
    ..^
-3.elisp:130:3: In another-bad-regexp-list: Duplicated `1' inside character 
alternative (pos 2)
+3.elisp:132:4: In another-bad-regexp-list: Duplicated `1' inside character 
alternative (pos 2)
   "[11]"
    ..^
-3.elisp:130:3: In another-bad-regexp-list: Duplicated `3' inside character 
alternative (pos 2)
+3.elisp:133:4: In another-bad-regexp-list: Duplicated `3' inside character 
alternative (pos 2)
   "[33]"
    ..^
-3.elisp:130:3: In another-bad-regexp-list: Duplicated `4' inside character 
alternative (pos 2)
+3.elisp:134:4: In another-bad-regexp-list: Duplicated `4' inside character 
alternative (pos 2)
   "[44]"
    ..^
-3.elisp:130:3: In another-bad-regexp-list: Duplicated `5' inside character 
alternative (pos 2)
+3.elisp:135:4: In another-bad-regexp-list: Duplicated `5' inside character 
alternative (pos 2)
   "[55]"
    ..^
-3.elisp:130:3: In another-bad-regexp-list: Duplicated `6' inside character 
alternative (pos 2)
+3.elisp:136:4: In another-bad-regexp-list: Duplicated `6' inside character 
alternative (pos 2)
   "[66]"
    ..^
-3.elisp:130:3: In another-bad-regexp-list: Duplicated `7' inside character 
alternative (pos 2)
+3.elisp:137:4: In another-bad-regexp-list: Duplicated `7' inside character 
alternative (pos 2)
   "[77]"
    ..^
 3.elisp:141:13: In call to looking-at: Unescaped literal `+' (pos 0)
diff --git a/test/9.expected b/test/9.expected
index 38469fd..ab3f06e 100644
--- a/test/9.expected
+++ b/test/9.expected
@@ -34,12 +34,12 @@
 9.elisp:19:33: In comment-end-skip: Duplicated `l' inside character 
alternative (pos 2)
   "[ll]"
    ..^
-9.elisp:23:34: In font-lock-defaults (tag): Duplicated `m' inside character 
alternative (pos 2)
+9.elisp:23:40: In font-lock-defaults (tag): Duplicated `m' inside character 
alternative (pos 2)
   "[mm]"
    ..^
-9.elisp:24:28: In font-lock-defaults (tag): Duplicated `n' inside character 
alternative (pos 2)
+9.elisp:24:34: In font-lock-defaults (tag): Duplicated `n' inside character 
alternative (pos 2)
   "[nn]"
    ..^
-9.elisp:25:50: In font-lock-defaults (tag): Duplicated `o' inside character 
alternative (pos 2)
+9.elisp:25:56: In font-lock-defaults (tag): Duplicated `o' inside character 
alternative (pos 2)
   "[oo]"
    ..^