master 96926fa6eb: Fix `lsh` warning shortcomings (bug#56641)

[Mattias Engdegård]

branch: master
commit 96926fa6eb0f71f47586d50ac5532b57bff1ab54
Author: Mattias Engdegård <mattiase@acm.org>
Commit: Mattias Engdegård <mattiase@acm.org>

    Fix `lsh` warning shortcomings (bug#56641)
    
    Reported by Basil Contovounesios.
    
    * etc/NEWS: Mention how to suppress the warning.
    * lisp/emacs-lisp/byte-run.el (with-suppressed-warnings): Amend doc string.
    * lisp/subr.el: Use `macroexp-warn-and-return` to delay the warning
    until codegen time (which makes it suppressible) and to prevent
    repeated warnings.
    * test/lisp/international/ccl-tests.el (shift):
    * test/src/data-tests.el (data-tests-ash-lsh):
    Suppress warning in tests of `lsh` itself.
---
 etc/NEWS                             |  4 +++-
 lisp/emacs-lisp/byte-run.el          |  2 +-
 lisp/subr.el                         |  5 ++---
 test/lisp/international/ccl-tests.el | 36 +++++++++++++++++++-----------------
 test/src/data-tests.el               | 13 +++++++------
 5 files changed, 32 insertions(+), 28 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 412a93bbf9..27046894ad 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -2336,7 +2336,9 @@ It's been obsolete since Emacs-22.1, actually.
 ** Calling 'lsh' now elicits a byte-compiler warning.
 'lsh' behaves in somewhat surprising and platform-dependent ways for
 negative arguments, and is generally slower than 'ash', which should be
-used instead.
+used instead.  This warning can be suppressed by surrounding calls to
+'lsh' with the construct '(with-suppressed-warnings ((suspicious lsh)) ...)',
+but switching to `ash` is generally much preferable.
 
 ---
 ** Some functions and variables obsolete since Emacs 24 have been removed:
diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el
index dd90bcf4d8..9370bd3a09 100644
--- a/lisp/emacs-lisp/byte-run.el
+++ b/lisp/emacs-lisp/byte-run.el
@@ -672,7 +672,7 @@ types.  The types that can be suppressed with this macro are
 `suspicious'.
 
 For the `mapcar' case, only the `mapcar' function can be used in
-the symbol list.  For `suspicious', only `set-buffer' can be used."
+the symbol list.  For `suspicious', only `set-buffer' and `lsh' can be used."
   ;; Note: during compilation, this definition is overridden by the one in
   ;; byte-compile-initial-macro-environment.
   (declare (debug (sexp body)) (indent 1))
diff --git a/lisp/subr.el b/lisp/subr.el
index 06da5e2873..a0ad967533 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -530,9 +530,8 @@ This function is provided for compatibility.  In new code, 
use `ash'
 instead."
   (declare (compiler-macro
             (lambda (form)
-              (when (byte-compile-warning-enabled-p 'suspicious 'lsh)
-                (byte-compile-warn-x form "avoid `lsh'; use `ash' instead"))
-              form)))
+              (macroexp-warn-and-return "avoid `lsh'; use `ash' instead"
+                                        form '(suspicious lsh) t form))))
   (when (and (< value 0) (< count 0))
     (when (< value most-negative-fixnum)
       (signal 'args-out-of-range (list value count)))
diff --git a/test/lisp/international/ccl-tests.el 
b/test/lisp/international/ccl-tests.el
index 57ac74639b..cf472415c7 100644
--- a/test/lisp/international/ccl-tests.el
+++ b/test/lisp/international/ccl-tests.el
@@ -25,23 +25,25 @@
 
 
 (ert-deftest shift ()
-  ;; shift left +ve                      5628     #x00000000000015fc
-  (should (= (ash  5628  8)           1440768)) ; #x000000000015fc00
-  (should (= (lsh  5628  8)           1440768)) ; #x000000000015fc00
-
-  ;; shift left -ve                     -5628     #x3fffffffffffea04
-  (should (= (ash -5628  8)          -1440768)) ; #x3fffffffffea0400
-  (should (= (lsh -5628  8)          -1440768)) ; #x3fffffffffea0400
-
-  ;; shift right +ve                     5628     #x00000000000015fc
-  (should (= (ash  5628 -8)                21)) ; #x0000000000000015
-  (should (= (lsh  5628 -8)                21)) ; #x0000000000000015
-
-  ;; shift right -ve                    -5628     #x3fffffffffffea04
-  (should (= (ash -5628 -8)               -22)) ; #x3fffffffffffffea
-  (should (= (lsh -5628 -8)
-             (ash (- -5628 (ash most-negative-fixnum 1)) -8)
-             (ash (logand (ash -5628 -1) most-positive-fixnum) -7))))
+  (with-suppressed-warnings ((suspicious lsh))
+
+    ;; shift left +ve                      5628     #x00000000000015fc
+    (should (= (ash  5628  8)           1440768)) ; #x000000000015fc00
+    (should (= (lsh  5628  8)           1440768)) ; #x000000000015fc00
+
+    ;; shift left -ve                     -5628     #x3fffffffffffea04
+    (should (= (ash -5628  8)          -1440768)) ; #x3fffffffffea0400
+    (should (= (lsh -5628  8)          -1440768)) ; #x3fffffffffea0400
+
+    ;; shift right +ve                     5628     #x00000000000015fc
+    (should (= (ash  5628 -8)                21)) ; #x0000000000000015
+    (should (= (lsh  5628 -8)                21)) ; #x0000000000000015
+
+    ;; shift right -ve                    -5628     #x3fffffffffffea04
+    (should (= (ash -5628 -8)               -22)) ; #x3fffffffffffffea
+    (should (= (lsh -5628 -8)
+               (ash (- -5628 (ash most-negative-fixnum 1)) -8)
+               (ash (logand (ash -5628 -1) most-positive-fixnum) -7)))))
 
 ;; CCl program from `pgg-parse-crc24' in lisp/obsolete/pgg-parse.el
 (defconst prog-pgg-source
diff --git a/test/src/data-tests.el b/test/src/data-tests.el
index 7ce2995e56..0f84b2fb77 100644
--- a/test/src/data-tests.el
+++ b/test/src/data-tests.el
@@ -741,14 +741,15 @@ comparing the subr with a much slower Lisp 
implementation."
   (should (= (ash 1000 (* 2 most-negative-fixnum)) 0))
   (should (= (ash -1000 (* 2 most-negative-fixnum)) -1))
   (should (= (ash (* 2 most-negative-fixnum) (* 2 most-negative-fixnum)) -1))
-  (should (= (lsh most-negative-fixnum 1)
-             (* most-negative-fixnum 2)))
   (should (= (ash (* 2 most-negative-fixnum) -1)
             most-negative-fixnum))
-  (should (= (lsh most-positive-fixnum -1) (/ most-positive-fixnum 2)))
-  (should (= (lsh most-negative-fixnum -1) (lsh (- most-negative-fixnum) -1)))
-  (should (= (lsh -1 -1) most-positive-fixnum))
-  (should-error (lsh (1- most-negative-fixnum) -1)))
+  (with-suppressed-warnings ((suspicious lsh))
+    (should (= (lsh most-negative-fixnum 1)
+               (* most-negative-fixnum 2)))
+    (should (= (lsh most-positive-fixnum -1) (/ most-positive-fixnum 2)))
+    (should (= (lsh most-negative-fixnum -1) (lsh (- most-negative-fixnum) 
-1)))
+    (should (= (lsh -1 -1) most-positive-fixnum))
+    (should-error (lsh (1- most-negative-fixnum) -1))))
 
 (ert-deftest data-tests-make-local-forwarded-var () ;bug#34318
   ;; Boy, this bug is tricky to trigger.  You need to: