[PATCH][gdb/fortran] Fix literal truncation

[Tom de Vries <tdevries@suse.de>]

Hi,

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.

Tested on x86_64-linux.

Any comments?

Thanks,
- Tom

[gdb/fortran] Fix literal truncation

---
 gdb/f-exp.y                             | 16 ++++++++++------
 gdb/testsuite/gdb.base/parse_number.exp | 24 +++++++++++++++---------
 2 files changed, 25 insertions(+), 15 deletions(-)

diff --git a/gdb/f-exp.y b/gdb/f-exp.y
index 90cc2c65c7b..908ba2cb071 100644
--- a/gdb/f-exp.y
+++ b/gdb/f-exp.y
@@ -1100,7 +1100,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 +1109,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 444f5d0534b..4439875837f 100644
--- a/gdb/testsuite/gdb.base/parse_number.exp
+++ b/gdb/testsuite/gdb.base/parse_number.exp
@@ -47,16 +47,10 @@ proc test_parse_numbers {arch} {
 
     if {$sizeof_long_long == 8 && $sizeof_long == 8} {
 	set 8B_type "unsigned long"
-	set fortran_type "unsigned long"
-	set fortran_value "0xffffffffffffffff"
     } elseif {$sizeof_long_long == 8 && $sizeof_long == 4 && $sizeof_int == 4} {
 	set 8B_type "unsigned long long"
-	set fortran_type "unsigned int"
-	set fortran_value "0xffffffff"
     } elseif {$sizeof_long == 4 && $sizeof_int == 2} {
 	set 8B_type "unsigned long long"
-	set fortran_type "unsigned long"
-	set fortran_value "0xffffffff"
     } else {
 	error "missing case for long long = $sizeof_long_long, long = $sizeof_long, int = $sizeof_int"
     }
@@ -68,13 +62,25 @@ proc test_parse_numbers {arch} {
 
 	gdb_test_no_output "set language $lang"
 
+	if { $lang == "modula-2" || $lang == "fortran" } {
+	    set re_overflow "Overflow on numeric constant\\."
+	} elseif { $lang == "ada" } {
+	    set re_overflow "Integer literal out of range"
+	} else {
+	    set re_overflow "Numeric constant too large\\."
+	}
+
 	set val "0xffffffffffffffff"
 	set val [hex_for_lang $lang $val]
 	if {$lang == "fortran"} {
-	    gdb_test "p/x $val" " = $fortran_value"
-	    gdb_test "ptype $val" " = $fortran_type"
+	    if { $sizeof_long == 4 } {
+		gdb_test "p/x $val" $re_overflow
+	    } else {
+		gdb_test "p/x $val" " = $val"
+		gdb_test "ptype $val" " = unsigned long"
+	    }
 	} elseif {$lang == "modula-2"} {
-	    gdb_test "p/x $val" "Overflow on numeric constant\\."
+	    gdb_test "p/x $val" $re_overflow
 	} else {
 	    # D and Rust define their own built-in 64-bit types, and
 	    # are thus always able to parse/print 64-bit values.