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

@@ -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:

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))

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)
+              (macroexp-warn-and-return "avoid `lsh'; use `ash' instead"
-                (byte-compile-warn-x form "avoid `lsh'; use `ash' instead"))
+                                        form '(suspicious lsh) t form))))
-              form)))
   (when (and (< value 0) (< count 0))
     (when (< value most-negative-fixnum)
       (signal 'args-out-of-range (list value count)))

test/lisp/international/ccl-tests.el

@@ -25,23 +25,25 @@
 
 
 (ert-deftest shift ()
-  ;; shift left +ve                      5628     #x00000000000015fc
+  (with-suppressed-warnings ((suspicious lsh))
-  (should (= (ash  5628  8)           1440768)) ; #x000000000015fc00
-  (should (= (lsh  5628  8)           1440768)) ; #x000000000015fc00
 
-  ;; shift left -ve                     -5628     #x3fffffffffffea04
+    ;; shift left +ve                      5628     #x00000000000015fc
-  (should (= (ash -5628  8)          -1440768)) ; #x3fffffffffea0400
+    (should (= (ash  5628  8)           1440768)) ; #x000000000015fc00
-  (should (= (lsh -5628  8)          -1440768)) ; #x3fffffffffea0400
+    (should (= (lsh  5628  8)           1440768)) ; #x000000000015fc00
 
-  ;; shift right +ve                     5628     #x00000000000015fc
+    ;; shift left -ve                     -5628     #x3fffffffffffea04
-  (should (= (ash  5628 -8)                21)) ; #x0000000000000015
+    (should (= (ash -5628  8)          -1440768)) ; #x3fffffffffea0400
-  (should (= (lsh  5628 -8)                21)) ; #x0000000000000015
+    (should (= (lsh -5628  8)          -1440768)) ; #x3fffffffffea0400
 
-  ;; shift right -ve                    -5628     #x3fffffffffffea04
+    ;; shift right +ve                     5628     #x00000000000015fc
-  (should (= (ash -5628 -8)               -22)) ; #x3fffffffffffffea
+    (should (= (ash  5628 -8)                21)) ; #x0000000000000015
-  (should (= (lsh -5628 -8)
+    (should (= (lsh  5628 -8)                21)) ; #x0000000000000015
-             (ash (- -5628 (ash most-negative-fixnum 1)) -8)
+
-             (ash (logand (ash -5628 -1) most-positive-fixnum) -7))))
+    ;; 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

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)))
+  (with-suppressed-warnings ((suspicious lsh))
-  (should (= (lsh most-negative-fixnum -1) (lsh (- most-negative-fixnum) -1)))
+    (should (= (lsh most-negative-fixnum 1)
-  (should (= (lsh -1 -1) most-positive-fixnum))
+               (* most-negative-fixnum 2)))
-  (should-error (lsh (1- most-negative-fixnum) -1)))
+    (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: