[binutils-gdb] [gdb/fortran] Fix literal truncation

[Tom de Vries <vries@sourceware.org>]

https://sourceware.org/git/gitweb.cgi?p=binutils-gdb.git;h=a2c0d041fdbf9d661099e31629c96cdd666e8b83

commit a2c0d041fdbf9d661099e31629c96cdd666e8b83
Author: Tom de Vries <tdevries@suse.de>
Date:   Sat Jun 4 13:17:33 2022 +0200

    [gdb/fortran] Fix literal truncation
    
    As mentioned in commit 5b758627a18 ("Make gdb.base/parse_number.exp test all
    architectures"):
    ...
        There might be a bug that 32-bit fortran truncates 64-bit values to
        32-bit, given "p/x 0xffffffffffffffff" returns "0xffffffff".
    ...
    
    More concretely, we have:
    ...
    $ for arch in i386:x86-64 i386; do \
        gdb -q -batch -ex "set arch $arch" -ex "set lang fortran" \
          -ex "p /x 0xffffffffffffffff"; \
      done
    The target architecture is set to "i386:x86-64".
    $1 = 0xffffffffffffffff
    The target architecture is set to "i386".
    $1 = 0xffffffff
    ...
    
    Fix this by adding a range check in parse_number in gdb/f-exp.y.
    
    Furthermore, make sure we error out on overflow instead of truncating in all
    other cases.
    
    Tested on x86_64-linux.

Diff:
---
 gdb/f-exp.y                             | 31 +++++++++++++++----------------
 gdb/testsuite/gdb.base/parse_number.exp |  4 +---
 2 files changed, 16 insertions(+), 19 deletions(-)

diff --git a/gdb/f-exp.y b/gdb/f-exp.y
index 90cc2c65c7b..62641083850 100644
--- a/gdb/f-exp.y
+++ b/gdb/f-exp.y
@@ -1076,16 +1076,11 @@ parse_number (struct parser_state *par_state,
 	  n *= base;
 	  n += i;
 	}
-      /* Portably test for overflow (only works for nonzero values, so make
-	 a second check for zero).  */
-      if ((prevn >= n) && n != 0)
-	unsigned_p=1;		/* Try something unsigned */
-      /* If range checking enabled, portably test for unsigned overflow.  */
-      if (RANGE_CHECK && n != 0)
-	{
-	  if ((unsigned_p && prevn >= n))
-	    range_error (_("Overflow on numeric constant."));
-	}
+      /* Test for overflow.  */
+      if (prevn == 0 && n == 0)
+	;
+      else if (RANGE_CHECK && prevn >= n)
+	range_error (_("Overflow on numeric constant."));
       prevn = n;
     }
   
@@ -1100,7 +1095,8 @@ parse_number (struct parser_state *par_state,
      but too many compilers warn about that, when ints and longs
      are the same size.  So we shift it twice, with fewer bits
      each time, for the same result.  */
-  
+
+  int bits_available;
   if ((gdbarch_int_bit (par_state->gdbarch ())
        != gdbarch_long_bit (par_state->gdbarch ())
        && ((n >> 2)
@@ -1108,19 +1104,22 @@ parse_number (struct parser_state *par_state,
 							    shift warning */
       || long_p)
     {
-      high_bit = ((ULONGEST)1)
-      << (gdbarch_long_bit (par_state->gdbarch ())-1);
+      bits_available = gdbarch_long_bit (par_state->gdbarch ());
       unsigned_type = parse_type (par_state)->builtin_unsigned_long;
       signed_type = parse_type (par_state)->builtin_long;
-    }
+  }
   else 
     {
-      high_bit =
-	((ULONGEST)1) << (gdbarch_int_bit (par_state->gdbarch ()) - 1);
+      bits_available = gdbarch_int_bit (par_state->gdbarch ());
       unsigned_type = parse_type (par_state)->builtin_unsigned_int;
       signed_type = parse_type (par_state)->builtin_int;
     }    
+  high_bit = ((ULONGEST)1) << (bits_available - 1);
   
+  if (RANGE_CHECK
+      && ((n >> 2) >> (bits_available - 2)))
+    range_error (_("Overflow on numeric constant."));
+
   putithere->typed_val.val = n;
   
   /* If the high bit of the worked out type is set then this number
diff --git a/gdb/testsuite/gdb.base/parse_number.exp b/gdb/testsuite/gdb.base/parse_number.exp
index 638ea342384..87554ccf995 100644
--- a/gdb/testsuite/gdb.base/parse_number.exp
+++ b/gdb/testsuite/gdb.base/parse_number.exp
@@ -176,9 +176,7 @@ proc parse_number { lang n } {
 	    return [list "unsigned long" $n]
 	} else {
 	    # Overflow.
-	    # Some truncated value or re_overflow, should be re_overflow.
-	    return [list "((unsigned )?(int|long)|$re_overflow)" \
-			($any|$re_overflow)]
+	    return [list $re_overflow $re_overflow]
 	}
     } else {
 	if { [c_like $lang] } {