[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/relint f42a48b 1/2: Don't crash when scanning pcase wit
From: |
Stefan Monnier |
Subject: |
[elpa] externals/relint f42a48b 1/2: Don't crash when scanning pcase with user-defined pcase macros |
Date: |
Fri, 26 Mar 2021 22:44:18 -0400 (EDT) |
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"
^