From 538707a5b434ff611d18354151cc9c494c3a5a6a Mon Sep 17 00:00:00 2001 From: Bernhard Heckel Date: Tue, 6 Sep 2016 15:45:57 +0200 Subject: Fortran: Fix negative bounds for dynamic allocated arrays. Fortran arrays might have negative bounds. Take this into consideration when evaluating dynamic bound properties. Bernhard Heckel 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 | 4 ++-- gdb/testsuite/gdb.fortran/vla-ptype.exp | 4 ++++ gdb/testsuite/gdb.fortran/vla-sizeof.exp | 4 ++++ gdb/testsuite/gdb.fortran/vla.f90 | 10 ++++++++++ 4 files changed, 20 insertions(+), 2 deletions(-) diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c index ec5c17a..0a2feac 100644 --- a/gdb/gdbtypes.c +++ b/gdb/gdbtypes.c @@ -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; diff --git a/gdb/testsuite/gdb.fortran/vla-ptype.exp b/gdb/testsuite/gdb.fortran/vla-ptype.exp index 175661f..544d40a 100644 --- a/gdb/testsuite/gdb.fortran/vla-ptype.exp +++ b/gdb/testsuite/gdb.fortran/vla-ptype.exp @@ -98,3 +98,7 @@ gdb_test "ptype vla2" "type = " "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" diff --git a/gdb/testsuite/gdb.fortran/vla-sizeof.exp b/gdb/testsuite/gdb.fortran/vla-sizeof.exp index 8010c0a..f8258a1 100644 --- a/gdb/testsuite/gdb.fortran/vla-sizeof.exp +++ b/gdb/testsuite/gdb.fortran/vla-sizeof.exp @@ -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" diff --git a/gdb/testsuite/gdb.fortran/vla.f90 b/gdb/testsuite/gdb.fortran/vla.f90 index c76d24c..ef307b7 100644 --- a/gdb/testsuite/gdb.fortran/vla.f90 +++ b/gdb/testsuite/gdb.fortran/vla.f90 @@ -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 -- cgit v1.1