[PATCH 3/3] gdb: Handle dynamic properties with negative values

Andrew Burgess
2019-05-05T20:57:19Z

When running a 32-bit inferior on a 64-bit platform, fetching dynamic
properties that are signed is not correctly sign extending the fetched
value from 32 to 64 bits. As a result, for example, a Fortran array
with negative array bounds will appear to GDB to have large positive
array bounds.

gdb/Changelog:

* dwarf2loc.h (dwarf2_evaluate_property): Add signed_p parameter.
* dwarf2loc.c (dwarf2_evaluate_property): Add signed_p parameter,
if this is true then sign extend the value before returning.
* findvar.c (follow_static_link): Update call to
dwarf2_evaluate_property.
* gdbtypes.c (resolve_dynamic_range): Likewise.
(resolve_dynamic_array): Likewise.
(resolve_dynamic_type_internal): Likewise.

gdb/testsuite/ChangeLog:

* gdb.fortran/vla-ptype.exp: Print array with negative bounds.
* gdb.fortran/vla-sizeof.exp: Print the size of an array with
negative bounds.
* gdb.fortran/vla-value.exp: Print elements of an array with
negative bounds.
* gdb.fortran/vla.f90: Setup an array with negative bounds for
testing.
---
gdb/ChangeLog | 12 ++++++++++++
gdb/dwarf2loc.c | 30 ++++++++++++++++++++++++------
gdb/dwarf2loc.h | 7 ++++++-
gdb/findvar.c | 2 +-
gdb/gdbtypes.c | 12 ++++++------
gdb/testsuite/ChangeLog | 11 +++++++++++
gdb/testsuite/gdb.fortran/vla-ptype.exp | 12 ++++++++++++
gdb/testsuite/gdb.fortran/vla-sizeof.exp | 10 ++++++++++
gdb/testsuite/gdb.fortran/vla-value.exp | 27 +++++++++++++++++++++++++++
gdb/testsuite/gdb.fortran/vla.f90 | 15 +++++++++++++++
10 files changed, 124 insertions(+), 14 deletions(-)

diff --git a/gdb/dwarf2loc.c b/gdb/dwarf2loc.c
index 411bf2912b2..ee229ae6de3 100644
--- a/gdb/dwarf2loc.c
+++ b/gdb/dwarf2loc.c
@@ -2428,8 +2428,10 @@ bool
dwarf2_evaluate_property (const struct dynamic_prop *prop,
struct frame_info *frame,
struct property_addr_info *addr_stack,
- CORE_ADDR *value)
+ CORE_ADDR *value, bool signed_p)
{
+ bool converted_p = false;
+
if (prop == NULL)
return false;

@@ -2453,7 +2455,7 @@ dwarf2_evaluate_property (const struct dynamic_prop *prop,

*value = value_as_address (val);
}
- return true;
+ converted_p = true;
}
}
break;
@@ -2475,7 +2477,7 @@ dwarf2_evaluate_property (const struct dynamic_prop *prop,
if (!value_optimized_out (val))
{
*value = value_as_address (val);
- return true;
+ converted_p = true;
}
}
}
@@ -2483,7 +2485,8 @@ dwarf2_evaluate_property (const struct dynamic_prop *prop,

case PROP_CONST:
*value = prop->data.const_val;
- return true;
+ converted_p = true;
+ break;

case PROP_ADDR_OFFSET:
{
@@ -2505,11 +2508,26 @@ dwarf2_evaluate_property (const struct dynamic_prop *prop,
val = value_at (baton->offset_info.type,
pinfo->addr + baton->offset_info.offset);
*value = value_as_address (val);
- return true;
+ converted_p = true;
}
+ break;
}

- return false;
+ if (converted_p && signed_p)
+ {
+ /* If we have a valid return candidate and it's value is signed,
+ we have to sign-extend the value because CORE_ADDR on 64bit
+ machine has 8 bytes but address size of an 32bit application
+ is 4 bytes. */
+ struct gdbarch * gdbarch = target_gdbarch ();
+ const int addr_bit = gdbarch_addr_bit (gdbarch);
+ const CORE_ADDR neg_mask = ((~0) << (addr_bit - 1));
+
+ /* Check if signed bit is set and sign-extend values. */
+ if (*value & (neg_mask))
+ *value |= (neg_mask );
+ }
+ return converted_p;
}

/* See dwarf2loc.h. */
diff --git a/gdb/dwarf2loc.h b/gdb/dwarf2loc.h
index ac1a771a9f3..7ebca31efc0 100644
--- a/gdb/dwarf2loc.h
+++ b/gdb/dwarf2loc.h
@@ -135,13 +135,18 @@ struct property_addr_info
property. When evaluating a property that is not related to a type, it can
be NULL.

+ SIGNED_P should be true if the property should be treated as a signed
+ value, and sign extended to the size of VALUE, or false to treat the
+ property as unsigned (for example, for address properties).
+
Returns true if PROP could be converted and the static value is passed
back into VALUE, otherwise returns false. */

bool dwarf2_evaluate_property (const struct dynamic_prop *prop,
struct frame_info *frame,
struct property_addr_info *addr_stack,
- CORE_ADDR *value);
+ CORE_ADDR *value,
+ bool signed_p);

/* A helper for the compiler interface that compiles a single dynamic
property to C code.
diff --git a/gdb/findvar.c b/gdb/findvar.c
index e89ee37ffc7..cefd0d0f2e3 100644
--- a/gdb/findvar.c
+++ b/gdb/findvar.c
@@ -433,7 +433,7 @@ follow_static_link (struct frame_info *frame,
{
CORE_ADDR upper_frame_base;

- if (!dwarf2_evaluate_property (static_link, frame, NULL, &upper_frame_base))
+ if (!dwarf2_evaluate_property (static_link, frame, NULL, &upper_frame_base, false))
return NULL;

/* Now climb up the stack frame until we reach the frame we are interested
diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
index fe52a64f212..479d30d05d3 100644
--- a/gdb/gdbtypes.c
+++ b/gdb/gdbtypes.c
@@ -1980,7 +1980,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 (prop, NULL, addr_stack, &value, true))
{
low_bound.kind = PROP_CONST;
low_bound.data.const_val = value;
@@ -1992,7 +1992,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 (prop, NULL, addr_stack, &value, true))
{
high_bound.kind = PROP_CONST;
high_bound.data.const_val = value;
@@ -2043,13 +2043,13 @@ resolve_dynamic_array (struct type *type,
/* Resolve allocated/associated here before creating a new array type, which
will update the length of the array accordingly. */
prop = TYPE_ALLOCATED_PROP (type);
- if (prop != NULL && dwarf2_evaluate_property (prop, NULL, addr_stack, &value))
+ if (prop != NULL && dwarf2_evaluate_property (prop, NULL, addr_stack, &value, false))
{
TYPE_DYN_PROP_ADDR (prop) = value;
TYPE_DYN_PROP_KIND (prop) = PROP_CONST;
}
prop = TYPE_ASSOCIATED_PROP (type);
- if (prop != NULL && dwarf2_evaluate_property (prop, NULL, addr_stack, &value))
+ if (prop != NULL && dwarf2_evaluate_property (prop, NULL, addr_stack, &value, false))
{
TYPE_DYN_PROP_ADDR (prop) = value;
TYPE_DYN_PROP_KIND (prop) = PROP_CONST;
@@ -2065,7 +2065,7 @@ resolve_dynamic_array (struct type *type,
prop = get_dyn_prop (DYN_PROP_BYTE_STRIDE, type);
if (prop != NULL)
{
- if (dwarf2_evaluate_property (prop, NULL, addr_stack, &value))
+ if (dwarf2_evaluate_property (prop, NULL, addr_stack, &value, true))
{
remove_dyn_prop (DYN_PROP_BYTE_STRIDE, type);
bit_stride = (unsigned int) (value * 8);
@@ -2282,7 +2282,7 @@ resolve_dynamic_type_internal (struct type *type,
/* Resolve data_location attribute. */
prop = TYPE_DATA_LOCATION (resolved_type);
if (prop != NULL
- && dwarf2_evaluate_property (prop, NULL, addr_stack, &value))
+ && dwarf2_evaluate_property (prop, NULL, addr_stack, &value, false))
{
TYPE_DYN_PROP_ADDR (prop) = value;
TYPE_DYN_PROP_KIND (prop) = PROP_CONST;
diff --git a/gdb/testsuite/gdb.fortran/vla-ptype.exp b/gdb/testsuite/gdb.fortran/vla-ptype.exp
index 0f4abb63757..7ad7ecdea65 100644
--- a/gdb/testsuite/gdb.fortran/vla-ptype.exp
+++ b/gdb/testsuite/gdb.fortran/vla-ptype.exp
@@ -98,3 +98,15 @@ 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-v1"]
+gdb_continue_to_breakpoint "vla1-neg-bounds-v1"
+gdb_test "ptype vla1" \
+ "type = $real, allocatable \\(-2:-1,-5:-2,-3:-1\\)" \
+ "ptype vla1 negative bounds"
+
+gdb_breakpoint [gdb_get_line_number "vla1-neg-bounds-v2"]
+gdb_continue_to_breakpoint "vla1-neg-bounds-v2"
+gdb_test "ptype vla1" \
+ "type = $real, allocatable \\(-2:1,-5:2,-3:1\\)" \
+ "ptype vla1 negative lower bounds, positive upper bounds"
diff --git a/gdb/testsuite/gdb.fortran/vla-sizeof.exp b/gdb/testsuite/gdb.fortran/vla-sizeof.exp
index 7f74a699d76..7527e0eb0b8 100644
--- a/gdb/testsuite/gdb.fortran/vla-sizeof.exp
+++ b/gdb/testsuite/gdb.fortran/vla-sizeof.exp
@@ -44,3 +44,13 @@ 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-v1"]
+gdb_continue_to_breakpoint "vla1-neg-bounds-v1"
+gdb_test "print sizeof(vla1)" " = 96" \
+ "print sizeof vla1 negative bounds"
+
+gdb_breakpoint [gdb_get_line_number "vla1-neg-bounds-v2"]
+gdb_continue_to_breakpoint "vla1-neg-bounds-v2"
+gdb_test "print sizeof(vla1)" " = 640" \
+ "print sizeof vla1 negative lower bounds, positive upper bounds"
diff --git a/gdb/testsuite/gdb.fortran/vla-value.exp b/gdb/testsuite/gdb.fortran/vla-value.exp
index be397fd95fb..3145d21c15c 100644
--- a/gdb/testsuite/gdb.fortran/vla-value.exp
+++ b/gdb/testsuite/gdb.fortran/vla-value.exp
@@ -161,3 +161,30 @@ gdb_breakpoint [gdb_get_line_number "pvla-deassociated"]
gdb_continue_to_breakpoint "pvla-deassociated"
gdb_test "print \$mypvar(1,3,8)" " = 1001" \
"print \$mypvar(1,3,8) after deallocated"
+
+gdb_breakpoint [gdb_get_line_number "vla1-neg-bounds-v1"]
+gdb_continue_to_breakpoint "vla1-neg-bounds-v1"
+with_test_prefix "negative bounds" {
+ gdb_test "print vla1(-2,-5,-3)" " = 1"
+ gdb_test "print vla1(-2,-3,-1)" " = -231"
+ gdb_test "print vla1(-3,-5,-3)" "no such vector element"
+ gdb_test "print vla1(-2,-6,-3)" "no such vector element"
+ gdb_test "print vla1(-2,-5,-4)" "no such vector element"
+ gdb_test "print vla1(0,-2,-1)" "no such vector element"
+ gdb_test "print vla1(-1,-1,-1)" "no such vector element"
+ gdb_test "print vla1(-1,-2,0)" "no such vector element"
+}
+
+gdb_breakpoint [gdb_get_line_number "vla1-neg-bounds-v2"]
+gdb_continue_to_breakpoint "vla1-neg-bounds-v2"
+with_test_prefix "negative lower bounds, positive upper bounds" {
+ gdb_test "print vla1(-2,-5,-3)" " = 2"
+ gdb_test "print vla1(-2,-3,-1)" " = 2"
+ gdb_test "print vla1(-2,-4,-2)" " = -242"
+ gdb_test "print vla1(-3,-5,-3)" "no such vector element"
+ gdb_test "print vla1(-2,-6,-3)" "no such vector element"
+ gdb_test "print vla1(-2,-5,-4)" "no such vector element"
+ gdb_test "print vla1(2,2,1)" "no such vector element"
+ gdb_test "print vla1(1,3,1)" "no such vector element"
+ gdb_test "print vla1(1,2,2)" "no such vector element"
+}
diff --git a/gdb/testsuite/gdb.fortran/vla.f90 b/gdb/testsuite/gdb.fortran/vla.f90
index 5bc608744b3..0ccb5c90d93 100644
--- a/gdb/testsuite/gdb.fortran/vla.f90
+++ b/gdb/testsuite/gdb.fortran/vla.f90
@@ -54,4 +54,19 @@ program vla

allocate (vla3 (2,2)) ! vla2-deallocated
vla3(:,:) = 13
+
+ allocate (vla1 (-2:-1, -5:-2, -3:-1))
+ vla1(:, :, :) = 1
+ vla1(-2, -3, -1) = -231
+
+ deallocate (vla1) ! vla1-neg-bounds-v1
+ l = allocated(vla1)
+
+ allocate (vla1 (-2:1, -5:2, -3:1))
+ vla1(:, :, :) = 2
+ vla1(-2, -4, -2) = -242
+
+ deallocate (vla1) ! vla1-neg-bounds-v2
+ l = allocated(vla1)
+
end program vla
--
2.14.5