Limit the range of ash, round-ash count argument to INT32

This avoids gmp aborting e.g. with (ash 1 (expt 2 37)). The new limit is
such that (ash 1 (expt 30)) is accepted but (ash 1 (expt 31)) throws.

Fixes https://bugs.gnu.org/48150

* libguile/numbers.c (ash, round-ash): As stated.
* test-suite/tests/numbers.test: Test a case known to make gmp abort before.

libguile/numbers.c

@@ -5110,35 +5110,28 @@ SCM_DEFINE (scm_ash, "ash", 2, 0, 0,
 	    "@end lisp")
 #define FUNC_NAME s_scm_ash
 {
-  if (SCM_I_INUMP (n) || SCM_BIGP (n))
+  if (!SCM_I_INUMP (n) && !SCM_BIGP (n))
-    {
-      long bits_to_shift;
-
-      if (SCM_I_INUMP (count))  /* fast path, not strictly needed */
-        bits_to_shift = SCM_I_INUM (count);
-      else if (scm_is_signed_integer (count, LONG_MIN + 1, LONG_MAX))
-        /* We exclude LONG_MIN to ensure that 'bits_to_shift' can be
-           negated without overflowing. */
-        bits_to_shift = scm_to_long (count);
-      else if (scm_is_false (scm_positive_p (scm_sum (scm_integer_length (n),
-                                                      count))))
-        /* Huge right shift that eliminates all but the sign bit */
-        return scm_is_false (scm_negative_p (n))
-          ? SCM_INUM0 : SCM_I_MAKINUM (-1);
-      else if (scm_is_true (scm_zero_p (n)))
-        return SCM_INUM0;
-      else
-        scm_num_overflow ("ash");
-
-      if (bits_to_shift > 0)
-        return left_shift_exact_integer (n, bits_to_shift);
-      else if (SCM_LIKELY (bits_to_shift < 0))
-        return floor_right_shift_exact_integer (n, -bits_to_shift);
-      else
-        return n;
-    }
-  else
     SCM_WRONG_TYPE_ARG (SCM_ARG1, n);
+  
+  if (scm_is_false (scm_positive_p (scm_sum (scm_integer_length (n),
+                                             count))))
+    /* Huge right shift that eliminates all but the sign bit */
+    return scm_is_false (scm_negative_p (n))
+      ? SCM_INUM0 : SCM_I_MAKINUM (-1);
+  else if (scm_is_true (scm_zero_p (n)))
+    return SCM_INUM0;
+  else if (scm_is_signed_integer (count, INT32_MIN + 1, INT32_MAX)) {
+    /* We exclude MIN to ensure that 'bits_to_shift' can be
+       negated without overflowing, if INT32_MIN happens to be LONG_MIN */
+    long bits_to_shift = scm_to_long (count);
+    if (bits_to_shift > 0)
+      return left_shift_exact_integer (n, bits_to_shift);
+    else if (SCM_LIKELY (bits_to_shift < 0))
+      return floor_right_shift_exact_integer (n, -bits_to_shift);
+    else
+      return n;
+  } else
+    scm_num_overflow ("ash");
 }
 #undef FUNC_NAME
 
@@ -5164,34 +5157,27 @@ SCM_DEFINE (scm_round_ash, "round-ash", 2, 0, 0,
 	    "@end lisp")
 #define FUNC_NAME s_scm_round_ash
 {
-  if (SCM_I_INUMP (n) || SCM_BIGP (n))
+  if (!SCM_I_INUMP (n) && !SCM_BIGP (n))
-    {
-      long bits_to_shift;
-
-      if (SCM_I_INUMP (count))  /* fast path, not strictly needed */
-        bits_to_shift = SCM_I_INUM (count);
-      else if (scm_is_signed_integer (count, LONG_MIN + 1, LONG_MAX))
-        /* We exclude LONG_MIN to ensure that 'bits_to_shift' can be
-           negated without overflowing. */
-        bits_to_shift = scm_to_long (count);
-      else if (scm_is_true (scm_negative_p (scm_sum (scm_integer_length (n),
-                                                     count)))
-               || scm_is_true (scm_zero_p (n)))
-        /* If N is zero, or the right shift count exceeds the integer
-           length, the result is zero. */
-        return SCM_INUM0;
-      else
-        scm_num_overflow ("round-ash");
-
-      if (bits_to_shift > 0)
-        return left_shift_exact_integer (n, bits_to_shift);
-      else if (SCM_LIKELY (bits_to_shift < 0))
-        return round_right_shift_exact_integer (n, -bits_to_shift);
-      else
-        return n;
-    }
-  else
     SCM_WRONG_TYPE_ARG (SCM_ARG1, n);
+  
+  if (scm_is_true (scm_negative_p (scm_sum (scm_integer_length (n),
+                                            count)))
+      || scm_is_true (scm_zero_p (n)))
+    /* If N is zero, or the right shift count exceeds the integer
+       length, the result is zero. */
+    return SCM_INUM0;
+  else if (scm_is_signed_integer (count, INT32_MIN + 1, INT32_MAX)) {
+    /* We exclude MIN to ensure that 'bits_to_shift' can be
+       negated without overflowing, if INT32_MIN happens to be LONG_MIN */
+    long bits_to_shift = scm_to_long (count);
+    if (bits_to_shift > 0)
+      return left_shift_exact_integer (n, bits_to_shift);
+    else if (SCM_LIKELY (bits_to_shift < 0))
+      return round_right_shift_exact_integer (n, -bits_to_shift);
+    else
+      return n;
+  } else 
+    scm_num_overflow ("round-ash");
 }
 #undef FUNC_NAME
 

test-suite/tests/numbers.test

@@ -5466,7 +5466,10 @@
         (ash-variant -1 (- (expt 2 1000))))
       (pass-if-exception "Huge left shift of non-zero => numerical overflow"
           exception:numerical-overflow
-        (ash-variant 123 (expt 2 1000)))))
+        (ash-variant 123 (expt 2 1000)))
+      (pass-if-exception "Shift large enough to cause gmp abort in 3.0.7"
+          exception:numerical-overflow
+        (ash-variant 1 (expt 2 37)))))
 
   (test-ash-variant       'ash       ash floor #f)
   (test-ash-variant 'round-ash round-ash round #t)