[PATCH 04/23] vla: make dynamic fortran arrays functional.
Keven Boell
keven.boell@intel.com
Wed Jun 4 05:54:00 GMT 2014
This patch enables GDB to print the value of a dynamic
array (VLA) if allocated/associated in fortran. If not the
allocation status will be printed to the command line.
(gdb) p vla_not_allocated
$1 = <not allocated>
(gdb) p vla_allocated
$1 = (1, 2, 3)
(gdb) p vla_not_associated
$1 = <not associated>
(gdb) p vla_associated
$1 = (3, 2, 1)
The patch covers various locations where the allocation/
association status makes sense to print.
2014-05-28 Keven Boell <keven.boell@intel.com>
Sanimir Agovic <sanimir.agovic@intel.com>
* dwarf2loc.c (dwarf2_address_data_valid): New
function.
* dwarf2loc.h (dwarf2_address_data_valid): New
function.
* f-typeprint.c (f_print_type): Print allocation/
association status.
(f_type_print_varspec_suffix): Print allocation/
association status for &-operator usages.
* gdbtypes.c (create_array_type_with_stride): Add
query for valid data location.
(is_dynamic_type): Extend dynamic type detection
with allocated/associated. Add type detection for
fields.
(resolve_dynamic_range): Copy type before resolving
it as dynamic attributes need to be preserved.
(resolve_dynamic_array): Copy type before resolving
it as dynamic attributes need to be preserved. Add
resolving of allocated/associated attributes.
(resolve_dynamic_type): Add call to nested
type resolving.
(copy_type_recursive): Add allocated/associated
attributes to be copied.
(copy_type): Copy allocated/associated/data_location
as well as the fields structure if available.
(resolve_dynamic_compound): New function.
* valarith.c (value_subscripted_rvalue): Print allocated/
associated status when indexing a VLA.
* valprint.c (valprint_check_validity): Print allocated/
associated status.
(val_print_not_allocated): New function.
(val_print_not_associated): New function.
* valprint.h (val_print_not_allocated): New function.
(val_print_not_associated): New function.
* value.c (set_value_component_location): Adjust the value
address for single value prints.
Change-Id: Idfb44c8a6b38008f8e2c84cb0fdb13729ec160f4
Signed-off-by: Keven Boell <keven.boell@intel.com>
---
gdb/dwarf2loc.c | 14 +++++
gdb/dwarf2loc.h | 6 ++
gdb/f-typeprint.c | 62 +++++++++++++-------
gdb/gdbtypes.c | 165 +++++++++++++++++++++++++++++++++++++++++++++++++++--
gdb/valarith.c | 9 ++-
gdb/valprint.c | 40 +++++++++++++
gdb/valprint.h | 4 ++
gdb/value.c | 20 +++++++
8 files changed, 292 insertions(+), 28 deletions(-)
diff --git a/gdb/dwarf2loc.c b/gdb/dwarf2loc.c
index 5402f66..7ab734d 100644
--- a/gdb/dwarf2loc.c
+++ b/gdb/dwarf2loc.c
@@ -2569,6 +2569,20 @@ dwarf2_evaluate_property (const struct dynamic_prop *prop, CORE_ADDR address,
return 0;
}
+/* See dwarf2loc.h. */
+
+int
+dwarf2_address_data_valid (const struct type *type)
+{
+ if (TYPE_NOT_ASSOCIATED (type))
+ return 0;
+
+ if (TYPE_NOT_ALLOCATED (type))
+ return 0;
+
+ return 1;
+}
+
/* Helper functions and baton for dwarf2_loc_desc_needs_frame. */
diff --git a/gdb/dwarf2loc.h b/gdb/dwarf2loc.h
index 04e2792..fb65c5c 100644
--- a/gdb/dwarf2loc.h
+++ b/gdb/dwarf2loc.h
@@ -102,6 +102,12 @@ int dwarf2_evaluate_property (const struct dynamic_prop *prop,
CORE_ADDR dwarf2_read_addr_index (struct dwarf2_per_cu_data *per_cu,
unsigned int addr_index);
+/* Checks if a dwarf location definition is valid.
+ Returns 1 if valid; 0 otherwise. */
+
+extern int dwarf2_address_data_valid (const struct type *type);
+
+
/* The symbol location baton types used by the DWARF-2 reader (i.e.
SYMBOL_LOCATION_BATON for a LOC_COMPUTED symbol). "struct
dwarf2_locexpr_baton" is for a symbol with a single location
diff --git a/gdb/f-typeprint.c b/gdb/f-typeprint.c
index 8356aab..69e67f4 100644
--- a/gdb/f-typeprint.c
+++ b/gdb/f-typeprint.c
@@ -30,6 +30,7 @@
#include "gdbcore.h"
#include "target.h"
#include "f-lang.h"
+#include "valprint.h"
#include <string.h>
#include <errno.h>
@@ -56,6 +57,17 @@ f_print_type (struct type *type, const char *varstring, struct ui_file *stream,
enum type_code code;
int demangled_args;
+ if (TYPE_NOT_ASSOCIATED (type))
+ {
+ val_print_not_associated (stream);
+ return;
+ }
+ if (TYPE_NOT_ALLOCATED (type))
+ {
+ val_print_not_allocated (stream);
+ return;
+ }
+
f_type_print_base (type, stream, show, level);
code = TYPE_CODE (type);
if ((varstring != NULL && *varstring != '\0')
@@ -170,28 +182,36 @@ f_type_print_varspec_suffix (struct type *type, struct ui_file *stream,
if (arrayprint_recurse_level == 1)
fprintf_filtered (stream, "(");
- if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY)
- f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0,
- arrayprint_recurse_level);
-
- lower_bound = f77_get_lowerbound (type);
- if (lower_bound != 1) /* Not the default. */
- fprintf_filtered (stream, "%d:", lower_bound);
-
- /* Make sure that, if we have an assumed size array, we
- print out a warning and print the upperbound as '*'. */
-
- if (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type))
- fprintf_filtered (stream, "*");
+ if (TYPE_NOT_ASSOCIATED (type))
+ val_print_not_associated (stream);
+ else if (TYPE_NOT_ALLOCATED (type))
+ val_print_not_allocated (stream);
else
- {
- upper_bound = f77_get_upperbound (type);
- fprintf_filtered (stream, "%d", upper_bound);
- }
-
- if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_ARRAY)
- f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0,
- arrayprint_recurse_level);
+ {
+
+ if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY)
+ f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0,
+ arrayprint_recurse_level);
+
+ lower_bound = f77_get_lowerbound (type);
+ if (lower_bound != 1) /* Not the default. */
+ fprintf_filtered (stream, "%d:", lower_bound);
+
+ /* Make sure that, if we have an assumed size array, we
+ print out a warning and print the upperbound as '*'. */
+
+ if (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type))
+ fprintf_filtered (stream, "*");
+ else
+ {
+ upper_bound = f77_get_upperbound (type);
+ fprintf_filtered (stream, "%d", upper_bound);
+ }
+
+ if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_ARRAY)
+ f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0,
+ arrayprint_recurse_level);
+ }
if (arrayprint_recurse_level == 1)
fprintf_filtered (stream, ")");
else
diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
index c12c159..79cd1be 100644
--- a/gdb/gdbtypes.c
+++ b/gdb/gdbtypes.c
@@ -1003,7 +1003,8 @@ create_array_type_with_stride (struct type *result_type,
TYPE_CODE (result_type) = TYPE_CODE_ARRAY;
TYPE_TARGET_TYPE (result_type) = element_type;
- if (has_static_range (TYPE_RANGE_DATA (range_type)))
+ if (has_static_range (TYPE_RANGE_DATA (range_type))
+ && dwarf2_address_data_valid (result_type))
{
LONGEST low_bound, high_bound;
@@ -1616,11 +1617,30 @@ stub_noname_complaint (void)
int
is_dynamic_type (struct type *type)
{
+ int index;
+
+ if (!type)
+ return 0;
+
type = check_typedef (type);
if (TYPE_CODE (type) == TYPE_CODE_REF)
type = check_typedef (TYPE_TARGET_TYPE (type));
+ if (TYPE_ASSOCIATED_PROP (type))
+ return 1;
+
+ if (TYPE_ALLOCATED_PROP (type))
+ return 1;
+
+ /* Scan field types in the Fortran case for nested dynamic types.
+ This will be done only for Fortran as in the C++ case an endless recursion
+ can occur in the area of classes. */
+ if (current_language->la_language == language_fortran)
+ for (index = 0; index < TYPE_NFIELDS (type); index++)
+ if (is_dynamic_type (TYPE_FIELD_TYPE (type, index)))
+ return 1;
+
switch (TYPE_CODE (type))
{
case TYPE_CODE_RANGE:
@@ -1657,6 +1677,7 @@ resolve_dynamic_range (struct type *dyn_range_type, CORE_ADDR addr)
const struct dynamic_prop *prop;
const struct dwarf2_locexpr_baton *baton;
struct dynamic_prop low_bound, high_bound;
+ struct type *range_copy = copy_type (dyn_range_type);
gdb_assert (TYPE_CODE (dyn_range_type) == TYPE_CODE_RANGE);
@@ -1688,8 +1709,8 @@ resolve_dynamic_range (struct type *dyn_range_type, CORE_ADDR addr)
high_bound.data.const_val = 0;
}
- static_range_type = create_range_type (copy_type (dyn_range_type),
- TYPE_TARGET_TYPE (dyn_range_type),
+ static_range_type = create_range_type (range_copy,
+ TYPE_TARGET_TYPE (range_copy),
&low_bound, &high_bound);
TYPE_RANGE_DATA (static_range_type)->flag_bound_evaluated = 1;
return static_range_type;
@@ -1706,6 +1727,8 @@ resolve_dynamic_array (struct type *type, CORE_ADDR addr)
struct type *elt_type;
struct type *range_type;
struct type *ary_dim;
+ struct dynamic_prop *prop;
+ struct type *copy = copy_type (type);
gdb_assert (TYPE_CODE (type) == TYPE_CODE_ARRAY);
@@ -1713,18 +1736,93 @@ resolve_dynamic_array (struct type *type, CORE_ADDR addr)
range_type = check_typedef (TYPE_INDEX_TYPE (elt_type));
range_type = resolve_dynamic_range (range_type, addr);
+ prop = TYPE_ALLOCATED_PROP (type);
+ if (dwarf2_evaluate_property (prop, addr, &value))
+ {
+ TYPE_ALLOCATED_PROP (copy)->kind = PROP_CONST;
+ TYPE_ALLOCATED_PROP (copy)->data.const_val = value;
+ }
+
+ prop = TYPE_ASSOCIATED_PROP (type);
+ if (dwarf2_evaluate_property (prop, addr, &value))
+ {
+ TYPE_ASSOCIATED_PROP (copy)->kind = PROP_CONST;
+ TYPE_ASSOCIATED_PROP (copy)->data.const_val = value;
+ }
+
ary_dim = check_typedef (TYPE_TARGET_TYPE (elt_type));
if (ary_dim != NULL && TYPE_CODE (ary_dim) == TYPE_CODE_ARRAY)
- elt_type = resolve_dynamic_array (TYPE_TARGET_TYPE (type), addr);
+ elt_type = resolve_dynamic_array (TYPE_TARGET_TYPE (copy), addr);
else
elt_type = TYPE_TARGET_TYPE (type);
- return create_array_type (copy_type (type),
+ return create_array_type (copy,
elt_type,
range_type);
}
+/* Resolves dynamic compound types, e.g. STRUCTS's to static ones.
+ ADDRESS is needed to resolve the compound type data location. */
+
+static struct type *
+resolve_dynamic_compound (struct type *type, CORE_ADDR addr)
+{
+ struct type *cur_type, *prev_type, *copy;
+ int index, depth = 0;
+
+ cur_type = type;
+ prev_type = cur_type;
+ while (cur_type)
+ {
+ switch (TYPE_CODE (cur_type))
+ {
+ case TYPE_CODE_STRUCT:
+ {
+ copy = copy_type (cur_type);
+ for (index = 0; index < TYPE_NFIELDS (copy); index++)
+ {
+ struct type *index_type = TYPE_FIELD_TYPE (copy, index);
+
+ if (index_type == NULL)
+ continue;
+
+ if (TYPE_CODE (index_type) == TYPE_CODE_ARRAY
+ || TYPE_CODE (index_type) == TYPE_CODE_STRUCT)
+ {
+ if (TYPE_CODE (index_type) != TYPE_CODE_RANGE)
+ addr +=
+ (TYPE_FIELD_BITPOS (copy, index) / 8);
+
+ TYPE_FIELD_TYPE (copy, index) =
+ resolve_dynamic_type (TYPE_FIELD_TYPE (copy, index),
+ addr);
+ }
+ }
+
+ /* If a struct type will be resolved as the first type, we need
+ to assign it back the resolved_type. In the other case it can
+ be that we have a struct, which is nested in another type.
+ Therefore we need to preserve the previous type, to assign the
+ new resolved type as the previous' target type. */
+ if (depth == 0)
+ type = copy;
+ else
+ TYPE_TARGET_TYPE (prev_type) = copy;
+ }
+ break;
+ }
+
+ /* Store the previous type, in order to assign resolved types back to
+ the right target type. */
+ prev_type = cur_type;
+ cur_type = TYPE_TARGET_TYPE (cur_type);
+ depth++;
+ };
+
+ return type;
+}
+
/* See gdbtypes.h */
struct type *
@@ -1733,7 +1831,7 @@ resolve_dynamic_type (struct type *type, CORE_ADDR addr)
struct type *real_type = check_typedef (type);
struct type *resolved_type = type;
const struct dynamic_prop *prop;
- CORE_ADDR value;
+ CORE_ADDR value, adjusted_address = addr;
if (!is_dynamic_type (real_type))
return type;
@@ -1771,12 +1869,15 @@ resolve_dynamic_type (struct type *type, CORE_ADDR addr)
prop = TYPE_DATA_LOCATION (type);
if (dwarf2_evaluate_property (prop, addr, &value))
{
+ adjusted_address = value;
TYPE_DATA_LOCATION_ADDR (type) = value;
TYPE_DATA_LOCATION_KIND (type) = PROP_CONST;
}
else
TYPE_DATA_LOCATION (type) = NULL;
+ resolved_type = resolve_dynamic_compound (type, adjusted_address);
+
return resolved_type;
}
@@ -3993,6 +4094,20 @@ copy_type_recursive (struct objfile *objfile,
*TYPE_DATA_LOCATION (new_type) = *TYPE_DATA_LOCATION (type);
}
+ /* Copy allocated information. */
+ if (TYPE_ALLOCATED_PROP (type) != NULL)
+ {
+ TYPE_ALLOCATED_PROP (new_type) = xmalloc (sizeof (struct dynamic_prop));
+ *TYPE_ALLOCATED_PROP (new_type) = *TYPE_ALLOCATED_PROP (type);
+ }
+
+ /* Copy associated information. */
+ if (TYPE_ASSOCIATED_PROP (type) != NULL)
+ {
+ TYPE_ASSOCIATED_PROP (new_type) = xmalloc (sizeof (struct dynamic_prop));
+ *TYPE_ASSOCIATED_PROP (new_type) = *TYPE_ASSOCIATED_PROP (type);
+ }
+
/* Copy pointers to other types. */
if (TYPE_TARGET_TYPE (type))
TYPE_TARGET_TYPE (new_type) =
@@ -4039,6 +4154,44 @@ copy_type (const struct type *type)
memcpy (TYPE_MAIN_TYPE (new_type), TYPE_MAIN_TYPE (type),
sizeof (struct main_type));
+ if (TYPE_ALLOCATED_PROP (type))
+ {
+ TYPE_ALLOCATED_PROP (new_type)
+ = OBSTACK_ZALLOC (&TYPE_OWNER (type).objfile->objfile_obstack,
+ struct dynamic_prop);
+ memcpy (TYPE_ALLOCATED_PROP (new_type), TYPE_ALLOCATED_PROP (type),
+ sizeof (struct dynamic_prop));
+ }
+
+ if (TYPE_ASSOCIATED_PROP (type))
+ {
+ TYPE_ASSOCIATED_PROP (new_type)
+ = OBSTACK_ZALLOC (&TYPE_OWNER (type).objfile->objfile_obstack,
+ struct dynamic_prop);
+ memcpy (TYPE_ASSOCIATED_PROP (new_type), TYPE_ASSOCIATED_PROP (type),
+ sizeof (struct dynamic_prop));
+ }
+
+ if (TYPE_DATA_LOCATION (type))
+ {
+ TYPE_DATA_LOCATION (new_type)
+ = OBSTACK_ZALLOC (&TYPE_OWNER (type).objfile->objfile_obstack,
+ struct dynamic_prop);
+ memcpy (TYPE_DATA_LOCATION (new_type), TYPE_DATA_LOCATION (type),
+ sizeof (struct dynamic_prop));
+ }
+
+ if (TYPE_NFIELDS (type))
+ {
+ int nfields = TYPE_NFIELDS (type);
+
+ TYPE_FIELDS (new_type)
+ = OBSTACK_CALLOC (&TYPE_OWNER (type).objfile->objfile_obstack,
+ nfields, struct field);
+ memcpy (TYPE_FIELDS (new_type), TYPE_FIELDS (type),
+ nfields * sizeof (struct field));
+ }
+
return new_type;
}
diff --git a/gdb/valarith.c b/gdb/valarith.c
index 8e863e3..bddb9db 100644
--- a/gdb/valarith.c
+++ b/gdb/valarith.c
@@ -200,7 +200,14 @@ value_subscripted_rvalue (struct value *array, LONGEST index, int lowerbound)
if (index < lowerbound || (!TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (array_type)
&& elt_offs >= TYPE_LENGTH (array_type)))
- error (_("no such vector element"));
+ {
+ if (TYPE_NOT_ASSOCIATED (array_type))
+ error (_("no such vector element because not associated"));
+ else if (TYPE_NOT_ALLOCATED (array_type))
+ error (_("no such vector element because not allocated"));
+ else
+ error (_("no such vector element"));
+ }
if (VALUE_LVAL (array) == lval_memory && value_lazy (array))
v = allocate_value_lazy (elt_type);
diff --git a/gdb/valprint.c b/gdb/valprint.c
index f55b5db..20096e9 100644
--- a/gdb/valprint.c
+++ b/gdb/valprint.c
@@ -307,6 +307,18 @@ valprint_check_validity (struct ui_file *stream,
{
CHECK_TYPEDEF (type);
+ if (TYPE_NOT_ASSOCIATED (type))
+ {
+ val_print_not_associated (stream);
+ return 0;
+ }
+
+ if (TYPE_NOT_ALLOCATED (type))
+ {
+ val_print_not_allocated (stream);
+ return 0;
+ }
+
if (TYPE_CODE (type) != TYPE_CODE_UNION
&& TYPE_CODE (type) != TYPE_CODE_STRUCT
&& TYPE_CODE (type) != TYPE_CODE_ARRAY)
@@ -362,6 +374,18 @@ val_print_invalid_address (struct ui_file *stream)
fprintf_filtered (stream, _("<invalid address>"));
}
+void
+val_print_not_allocated (struct ui_file *stream)
+{
+ fprintf_filtered (stream, _("<not allocated>"));
+}
+
+void
+val_print_not_associated (struct ui_file *stream)
+{
+ fprintf_filtered (stream, _("<not associated>"));
+}
+
/* A generic val_print that is suitable for use by language
implementations of the la_val_print method. This function can
handle most type codes, though not all, notably exception
@@ -803,12 +827,16 @@ static int
value_check_printable (struct value *val, struct ui_file *stream,
const struct value_print_options *options)
{
+ const struct type *type;
+
if (val == 0)
{
fprintf_filtered (stream, _("<address of value unknown>"));
return 0;
}
+ type = value_type (val);
+
if (value_entirely_optimized_out (val))
{
if (options->summary && !val_print_scalar_type_p (value_type (val)))
@@ -834,6 +862,18 @@ value_check_printable (struct value *val, struct ui_file *stream,
return 0;
}
+ if (TYPE_NOT_ASSOCIATED (type))
+ {
+ val_print_not_associated (stream);
+ return 0;
+ }
+
+ if (TYPE_NOT_ALLOCATED (type))
+ {
+ val_print_not_allocated (stream);
+ return 0;
+ }
+
return 1;
}
diff --git a/gdb/valprint.h b/gdb/valprint.h
index 6698247..7a415cf 100644
--- a/gdb/valprint.h
+++ b/gdb/valprint.h
@@ -217,4 +217,8 @@ extern void output_command_const (const char *args, int from_tty);
extern int val_print_scalar_type_p (struct type *type);
+extern void val_print_not_allocated (struct ui_file *stream);
+
+extern void val_print_not_associated (struct ui_file *stream);
+
#endif
diff --git a/gdb/value.c b/gdb/value.c
index 1c88dfd..08593b6 100644
--- a/gdb/value.c
+++ b/gdb/value.c
@@ -43,6 +43,7 @@
#include "tracepoint.h"
#include "cp-abi.h"
#include "user-regs.h"
+#include "dwarf2loc.h"
/* Prototypes for exported functions. */
@@ -1636,6 +1637,25 @@ set_value_component_location (struct value *component,
if (funcs->copy_closure)
component->location.computed.closure = funcs->copy_closure (whole);
}
+
+ /* For dynamic types compute the address of the component value location in
+ sub range types based on the location of the sub range type, if not being
+ an internal GDB variable or parts of it. */
+ if (VALUE_LVAL (component) != lval_internalvar
+ && VALUE_LVAL (component) != lval_internalvar_component)
+ {
+ CORE_ADDR addr;
+ struct type *type = value_type (whole);
+
+ addr = value_raw_address (component);
+
+ if (TYPE_DATA_LOCATION (type)
+ && TYPE_DATA_LOCATION_KIND (type) == PROP_CONST)
+ {
+ addr = TYPE_DATA_LOCATION_ADDR (type);
+ set_value_address (component, addr);
+ }
+ }
}
--
1.7.9.5
More information about the Gdb-patches
mailing list