[Emacs-diffs] master 5dff490: Fix signal for large integers with valid syntax

[Paul Eggert]

branch: master
commit 5dff4905d73d0d42447ff4b114d1af726a689c6a
Author: Paul Eggert <address@hidden>
Commit: Paul Eggert <address@hidden>

    Fix signal for large integers with valid syntax
    
    * src/lread.c (read_integer): If a radixed integer has valid syntax
    but is waayyy too large, signal overflow instead of invalid syntax.
    * test/src/lread-tests.el (lread-long-hex-integer): New test.
---
 src/lread.c             | 19 ++++++++++---------
 test/src/lread-tests.el |  5 +++++
 2 files changed, 15 insertions(+), 9 deletions(-)

diff --git a/src/lread.c b/src/lread.c
index 65d22af..6eda740 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -2644,14 +2644,13 @@ read_integer (Lisp_Object readcharfun, EMACS_INT radix)
      Also, room for invalid syntax diagnostic.  */
   char buf[max (1 + 1 + UINTMAX_WIDTH + 1,
                sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT))];
-
+  char *p = buf;
   int valid = -1; /* 1 if valid, 0 if not, -1 if incomplete.  */
 
   if (radix < 2 || radix > 36)
     valid = 0;
   else
     {
-      char *p = buf;
       int c, digit;
 
       c = READCHAR;
@@ -2679,17 +2678,12 @@ read_integer (Lisp_Object readcharfun, EMACS_INT radix)
            valid = 0;
          if (valid < 0)
            valid = 1;
-
-         if (p < buf + sizeof buf - 1)
-           *p++ = c;
-         else
-           valid = 0;
-
+         *p = c;
+         p += p < buf + sizeof buf;
          c = READCHAR;
        }
 
       UNREAD (c);
-      *p = '\0';
     }
 
   if (valid != 1)
@@ -2698,6 +2692,13 @@ read_integer (Lisp_Object readcharfun, EMACS_INT radix)
       invalid_syntax (buf);
     }
 
+  if (p == buf + sizeof buf)
+    {
+      memset (p - 3, '.', 3);
+      xsignal1 (Qoverflow_error, make_unibyte_string (buf, sizeof buf));
+    }
+
+  *p = '\0';
   return string_to_number (buf, radix, 0);
 }
 
diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el
index daf5343..708701a 100644
--- a/test/src/lread-tests.el
+++ b/test/src/lread-tests.el
@@ -194,4 +194,9 @@ literals (Bug#20852)."
     (lread--substitute-object-in-subtree x 1 t)
     (should (eq x (cdr x)))))
 
+(ert-deftest lread-long-hex-integer ()
+  (should-error
+   (read 
"#xffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff")
+   :type 'overflow-error))
+
 ;;; lread-tests.el ends here