[02/11] Fortran: Fix negative bounds for dynamic allocated arrays.
Commit Message
From: Bernhard Heckel <bernhard.heckel@intel.com>
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.
---
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(-)
Comments
* Sebastian Basierski <sbasierski@pl.sii.eu> [2018-11-27 19:31:30 +0100]:
> From: Bernhard Heckel <bernhard.heckel@intel.com>
>
> 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.
The last two lines of this ChangeLog entry are not correct, the
'gdb/testsuite' prefix is not needed.
It feels like this patch is trying to test the previous one in the
series, but like I said these tests all seem to pass on
upstream/master, so I think some additional investigation is needed.
Thanks,
Andrew
> ---
> 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 9e87b8f4c5..8adf899f9a 100644
> --- a/gdb/gdbtypes.c
> +++ b/gdb/gdbtypes.c
> @@ -1995,7 +1995,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;
> @@ -2007,7 +2007,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 5f367348b0..5351a0aa2e 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 = <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"
> diff --git a/gdb/testsuite/gdb.fortran/vla-sizeof.exp b/gdb/testsuite/gdb.fortran/vla-sizeof.exp
> index 3113983ba4..83bc849619 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 508290a36e..d87f59b92b 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
> --
> 2.17.1
>
@@ -1995,7 +1995,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;
@@ -2007,7 +2007,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;
@@ -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"
@@ -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"
@@ -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