master fffa53ff1a 2/2: Have 'cl-case' warn about suspicious cases

[Lars Ingebrigtsen]

branch: master
commit fffa53ff1afe097fe38f7664df5debe9811201d1
Author: Philipp Stephani <phst@google.com>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    Have 'cl-case' warn about suspicious cases
    
    * lisp/emacs-lisp/cl-macs.el (cl-case): Warn if the user passes a nil
    key list (which would never match).  Warn about quoted symbols that
    should probably be unquoted.
    
    * test/lisp/emacs-lisp/cl-macs-tests.el (cl-case-warning): New unit
    test (bug#51368).
---
 lisp/emacs-lisp/cl-macs.el            | 15 +++++++++++++++
 test/lisp/emacs-lisp/cl-macs-tests.el | 32 ++++++++++++++++++++++++++++++++
 2 files changed, 47 insertions(+)

diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 946d2c09a9..5d330f32d6 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -788,6 +788,21 @@ compared by `eql'.
                          ((eq (car c) 'cl--ecase-error-flag)
                           `(error "cl-ecase failed: %s, %s"
                                   ,temp ',(reverse head-list)))
+                         ((null (car c))
+                          (macroexp-warn-and-return
+                           "Case nil will never match"
+                           nil 'suspicious))
+                         ((and (consp (car c)) (not (cddar c))
+                               (memq (caar c) '(quote function)))
+                          (macroexp-warn-and-return
+                           (format-message
+                            (concat "Case %s will match `%s'.  If "
+                                    "that's intended, write %s "
+                                    "instead.  Otherwise, don't "
+                                    "quote `%s'.")
+                            (car c) (caar c) (list (cadar c) (caar c))
+                            (cadar c))
+                           `(cl-member ,temp ',(car c)) 'suspicious))
                          ((listp (car c))
                           (setq head-list (append (car c) head-list))
                           `(cl-member ,temp ',(car c)))
diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el 
b/test/lisp/emacs-lisp/cl-macs-tests.el
index 77817abd85..427b8f4689 100644
--- a/test/lisp/emacs-lisp/cl-macs-tests.el
+++ b/test/lisp/emacs-lisp/cl-macs-tests.el
@@ -25,6 +25,8 @@
 (require 'cl-macs)
 (require 'edebug)
 (require 'ert)
+(require 'ert-x)
+(require 'pcase)
 
 
 ;;;; cl-loop tests -- many adapted from Steele's CLtL2
@@ -758,4 +760,34 @@ collection clause."
         (should (equal (cdr error)
                        '("Misplaced t or `otherwise' clause")))))))
 
+(ert-deftest cl-case-warning ()
+  "Test that `cl-case' and `cl-ecase' warn about suspicious
+constructs."
+  (pcase-dolist (`(,case . ,message)
+                 `((nil . "Case nil will never match")
+                   ('nil . ,(concat "Case 'nil will match `quote'.  "
+                                    "If that's intended, write "
+                                    "(nil quote) instead.  "
+                                    "Otherwise, don't quote `nil'."))
+                   ('t . ,(concat "Case 't will match `quote'.  "
+                                  "If that's intended, write "
+                                  "(t quote) instead.  "
+                                  "Otherwise, don't quote `t'."))
+                   ('foo . ,(concat "Case 'foo will match `quote'.  "
+                                    "If that's intended, write "
+                                    "(foo quote) instead.  "
+                                    "Otherwise, don't quote `foo'."))
+                   (#'foo . ,(concat "Case #'foo will match "
+                                     "`function'.  If that's "
+                                     "intended, write (foo function) "
+                                     "instead.  Otherwise, don't "
+                                     "quote `foo'."))))
+    (dolist (macro '(cl-case cl-ecase))
+      (let ((form `(,macro val (,case 1))))
+        (ert-info ((prin1-to-string form) :prefix "Form: ")
+          (ert-with-message-capture messages
+            (macroexpand form)
+            (should (equal messages
+                           (concat "Warning: " message "\n")))))))))
+
 ;;; cl-macs-tests.el ends here