[elpa] externals/relint f42a48b 1/2: Don't crash when scanning pcase with user-defined pcase macros

[Stefan Monnier]

branch: externals/relint
commit f42a48b042817b4621dbcae97e8e8f48dfe68641
Author: Mattias Engdegård <mattiase@acm.org>
Commit: Mattias Engdegård <mattiase@acm.org>

    Don't crash when scanning pcase with user-defined pcase macros
---
 relint.el       | 8 +++++++-
 test/4.elisp    | 3 ++-
 test/4.expected | 6 +++---
 3 files changed, 12 insertions(+), 5 deletions(-)

diff --git a/relint.el b/relint.el
index 3c17a57..43153e3 100644
--- a/relint.el
+++ b/relint.el
@@ -747,10 +747,16 @@ not be evaluated safely."
        ;; may expand their arguments eagerly, running arbitrary code!
        ((memq head '(when unless
                      \` backquote-list*
-                     pcase pcase-let pcase-let* pcase--flip
                      cl-case cl-loop cl-block cl-flet cl-flet* cl-labels))
         (relint--eval (macroexpand-1 form)))
 
+       ;; Expanding pcase can fail if it uses user-defined pcase macros.
+       ((memq head '(pcase pcase-let pcase-let* pcase--flip))
+        (relint--eval
+         (condition-case nil
+             (macroexpand-1 form)
+           (error (throw 'relint-eval 'no-value)))))
+
        ;; catch: as long as nobody throws, this naïve code is fine.
        ((eq head 'catch)
         (relint--eval-body (cdr body)))
diff --git a/test/4.elisp b/test/4.elisp
index d5f864c..be9038e 100644
--- a/test/4.elisp
+++ b/test/4.elisp
@@ -45,7 +45,8 @@
   (looking-at (unless nil "c++"))
   (looking-at (string-join `("a" ,@(list "$") ,"b")))
   (looking-at (pcase 'a ((pred symbolp) "d++")))
-  (looking-at (cl-case 'z (b "m") (z "*"))))
+  (looking-at (cl-case 'z (b "m") (z "*")))
+  (looking-at (pcase 'q ((myhomemademacro) "**"))))
 
 ;; Test repeated use of global variable
 (defconst my-var-a "*")
diff --git a/test/4.expected b/test/4.expected
index 9d5488c..c5d7ff5 100644
--- a/test/4.expected
+++ b/test/4.expected
@@ -49,12 +49,12 @@
 4.elisp:48:15: In call to looking-at: Unescaped literal `*' (pos 0)
   "*"
    ^
-4.elisp:55:15: In call to looking-at: Unescaped literal `*' (pos 0)
+4.elisp:56:15: In call to looking-at: Unescaped literal `*' (pos 0)
   "*b"
    ^
-4.elisp:56:15: In call to looking-at: Unescaped literal `*' (pos 0)
+4.elisp:57:15: In call to looking-at: Unescaped literal `*' (pos 0)
   "*bc"
    ^
-4.elisp:62:15: In call to looking-at: Unescaped literal `*' (pos 0)
+4.elisp:63:15: In call to looking-at: Unescaped literal `*' (pos 0)
   "*a"
    ^