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.

diff --git a/etc/NEWS b/etc/NEWS
index 412a93bbf997a3e192639733b6fcdaf1c0019633..27046894ad4a9db1a9def3628e0788842ee98196 100644 (file)
--- 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 dd90bcf4d8244b724791b4ecfbc80eee05aac71e..9370bd3a097596ae27df1e7d9ba4edb4ae2990ba 100644 (file)
--- 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 06da5e28730930c726eb06a361689c9216d7c4fa..a0ad967533d0ee6fe28b7af9b7fb0acac15011c9 100644 (file)
--- 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 57ac74639b108df227fbffdbc53c64b0f56476df..cf472415c7a9a5acad6fc725a7cd7c49efbb992b 100644 (file)
--- 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 7ce2995e562cec5ad04abb48a5b21f9bc1ff2326..0f84b2fb7767367195a381a3a1084de5810d5da7 100644 (file)
--- 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: