]> git.ipfire.org Git - thirdparty/binutils-gdb.git/commitdiff
Fortran: Fix negative bounds for dynamic allocated arrays.
authorBernhard Heckel <bernhard.heckel@intel.com>
Tue, 6 Sep 2016 13:45:57 +0000 (15:45 +0200)
committerBernhard Heckel <bernhard.heckel@intel.com>
Wed, 7 Sep 2016 10:08:02 +0000 (12:08 +0200)
Fortran arrays might have negative bounds.
Take this into consideration when evaluating
dynamic bound properties.

Bernhard Heckel  <bernhard.heckel@intel.com>

gdb/Changelog:
* gdbtypes.c (resolve_dynamic_range):
  Call dwarf2_evaluate_property_signed to resolve dynamic bounds.

gdb/Testsuite/Changelog:
* gdb.fortran/vla.f90: Extend by an array with negative bounds.
* gdb/testsuite/gdb.fortran/vla-sizeof.exp: Test array with negative bounds.
* gdb/testsuite/gdb.fortran/vla-ptype.exp: Test array with negative bounds.

Change-Id: Idb35164f72c95a1daafe5db0c0855d742bea5ea7

gdb/gdbtypes.c
gdb/testsuite/gdb.fortran/vla-ptype.exp
gdb/testsuite/gdb.fortran/vla-sizeof.exp
gdb/testsuite/gdb.fortran/vla.f90

index ec5c17a879ef385e4392f1b7ec2a292e07ee3d2c..0a2feac6ca29f201dd780efc4b4ef84a52a11b04 100644 (file)
@@ -1893,7 +1893,7 @@ resolve_dynamic_range (struct type *dyn_range_type,
   gdb_assert (TYPE_CODE (dyn_range_type) == TYPE_CODE_RANGE);
 
   prop = &TYPE_RANGE_DATA (dyn_range_type)->low;
-  if (dwarf2_evaluate_property (prop, NULL, addr_stack, &value))
+  if (dwarf2_evaluate_property_signed (prop, NULL, addr_stack, &value, 1))
     {
       low_bound.kind = PROP_CONST;
       low_bound.data.const_val = value;
@@ -1905,7 +1905,7 @@ resolve_dynamic_range (struct type *dyn_range_type,
     }
 
   prop = &TYPE_RANGE_DATA (dyn_range_type)->high;
-  if (dwarf2_evaluate_property (prop, NULL, addr_stack, &value))
+  if (dwarf2_evaluate_property_signed (prop, NULL, addr_stack, &value, 1))
     {
       high_bound.kind = PROP_CONST;
       high_bound.data.const_val = value;
index 175661fa7d276dbe5007a3874e0858e3fd02c026..544d40a03b2013953bbe75c7744897e5fdb55891 100644 (file)
@@ -98,3 +98,7 @@ gdb_test "ptype vla2" "type = <not allocated>" "ptype vla2 not allocated"
 gdb_test "ptype vla2(5, 45, 20)" \
   "no such vector element \\\(vector not allocated\\\)" \
   "ptype vla2(5, 45, 20) not allocated"
+
+gdb_breakpoint [gdb_get_line_number "vla1-neg-bounds"]
+gdb_continue_to_breakpoint "vla1-neg-bounds"
+gdb_test "ptype vla1" "type = $real \\(-2:1,-5:4,-3:-1\\)" "ptype vla1 negative bounds"
index 8010c0a6a182e9664895f58a27434741dc1fd9f2..f8258a15295af2f7ae9441271a1c8934e17ae765 100644 (file)
@@ -44,3 +44,7 @@ gdb_test "print sizeof(pvla)" " = 0" "print sizeof non-associated pvla"
 gdb_breakpoint [gdb_get_line_number "pvla-associated"]
 gdb_continue_to_breakpoint "pvla-associated"
 gdb_test "print sizeof(pvla)" " = 4000" "print sizeof associated pvla"
+
+gdb_breakpoint [gdb_get_line_number "vla1-neg-bounds"]
+gdb_continue_to_breakpoint "vla1-neg-bounds"
+gdb_test "print sizeof(vla1)" " = 480" "print sizeof vla1 negative bounds"
index c76d24cfa853a8ebf69e5dd4016f05a723a4edd5..ef307b7da4054799c240e63543dc67d79ae56cb1 100644 (file)
@@ -54,4 +54,14 @@ program vla
 
   allocate (vla3 (2,2))               ! vla2-deallocated
   vla3(:,:) = 13
+
+  allocate (vla1 (-2:1, -5:4, -3:-1))
+  l = allocated(vla1)
+
+  vla1(:, :, :) = 1
+  vla1(-2, -3, -1) = -231
+
+  deallocate (vla1)                   ! vla1-neg-bounds
+  l = allocated(vla1)
+
 end program vla