[PATCH 1/2] fort_dyn_array: add basic fortran dyn array support
Keven Boell
keven.boell@intel.com
Wed Jul 1 12:42:00 GMT 2015
Fortran provide types whose values may be dynamically allocated
or associated with a variable under explicit program control.
The purpose of this commit is
* to read allocated/associated DWARF tags and store them in
the dynamic property list of main_type.
* enable GDB to print the value of a dynamic array in Fortran
in case the type is allocated or associated (pointer to
dynamic array).
Examples:
(gdb) p vla_not_allocated
$1 = <not allocated>
(gdb) p vla_allocated
$1 = (1, 2, 3)
(gdb) p vla_ptr_not_associated
$1 = <not associated>
(gdb) p vla_ptr_associated
$1 = (1, 2, 3)
2015-03-13 Keven Boell <keven.boell@intel.com>
* dwarf2loc.c (dwarf2_address_data_valid): New
function.
* dwarf2loc.h (dwarf2_address_data_valid): New
function.
* dwarf2read.c (set_die_type): Add read of
DW_AT_allocated and DW_AT_associated.
* f-typeprint.c (f_print_type): Add check for
allocated/associated status of type.
(f_type_print_varspec_suffix): Add check for
allocated/associated status of type.
* gdbtypes.c (create_array_type_with_stride):
Add check for valid data location of type in
case allocated or associated attributes are set.
Length of an array should be only calculated if
allocated or associated is resolved as true.
(is_dynamic_type_internal): Add check for allocated/
associated.
(resolve_dynamic_array): Evaluate allocated/associated
properties. Since at the end of the function a new
array type will be created where the length is
calculated the properties need to be resolved before.
* gdbtypes.h (enum dynamic_prop_node_kind): Add
allocated/associated.
Add convenient macros to handle allocated/associated.
* valarith.c (value_subscripted_rvalue): Add check for
allocated/associated.
* valprint.c (valprint_check_validity): Add check for
allocated/associated.
(val_print_not_allocated): New function.
(val_print_not_associated): New function.
(value_check_printable): Add check for allocated/
associated.
* valprint.h (val_print_not_allocated): New function.
(val_print_not_associated): New function.
---
gdb/dwarf2loc.c | 11 +++++++++++
gdb/dwarf2loc.h | 4 ++++
gdb/dwarf2read.c | 16 ++++++++++++++++
gdb/f-typeprint.c | 20 ++++++++++++++++++++
gdb/gdbtypes.c | 33 ++++++++++++++++++++++++++++-----
gdb/gdbtypes.h | 28 ++++++++++++++++++++++++++++
gdb/valarith.c | 9 ++++++++-
gdb/valprint.c | 36 ++++++++++++++++++++++++++++++++++++
gdb/valprint.h | 4 ++++
9 files changed, 155 insertions(+), 6 deletions(-)
diff --git a/gdb/dwarf2loc.c b/gdb/dwarf2loc.c
index c75767e..c4a43ca 100644
--- a/gdb/dwarf2loc.c
+++ b/gdb/dwarf2loc.c
@@ -2576,6 +2576,17 @@ dwarf2_compile_property_to_c (struct ui_file *stream,
data, data + size, per_cu);
}
+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 f3630ac..c664c4d 100644
--- a/gdb/dwarf2loc.h
+++ b/gdb/dwarf2loc.h
@@ -155,6 +155,10 @@ void dwarf2_compile_property_to_c (struct ui_file *stream,
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/dwarf2read.c b/gdb/dwarf2read.c
index 496b74f..69caa04 100644
--- a/gdb/dwarf2read.c
+++ b/gdb/dwarf2read.c
@@ -22263,6 +22263,22 @@ set_die_type (struct die_info *die, struct type *type, struct dwarf2_cu *cu)
&& !HAVE_GNAT_AUX_INFO (type))
INIT_GNAT_SPECIFIC (type);
+ /* Read DW_AT_allocated and set in type. */
+ attr = dwarf2_attr (die, DW_AT_allocated, cu);
+ if (attr_form_is_block (attr))
+ {
+ if (attr_to_dynamic_prop (attr, die, cu, &prop))
+ add_dyn_prop (DYN_PROP_ALLOCATED, prop, type, objfile);
+ }
+
+ /* Read DW_AT_associated and set in type. */
+ attr = dwarf2_attr (die, DW_AT_associated, cu);
+ if (attr_form_is_block (attr))
+ {
+ if (attr_to_dynamic_prop (attr, die, cu, &prop))
+ add_dyn_prop (DYN_PROP_ASSOCIATED, prop, type, objfile);
+ }
+
/* Read DW_AT_data_location and set in type. */
attr = dwarf2_attr (die, DW_AT_data_location, cu);
if (attr_to_dynamic_prop (attr, die, cu, &prop))
diff --git a/gdb/f-typeprint.c b/gdb/f-typeprint.c
index 4957e1f..50efbdb 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"
#if 0 /* Currently unused. */
static void f_type_print_args (struct type *, struct ui_file *);
@@ -53,6 +54,18 @@ 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')
@@ -167,6 +180,12 @@ f_type_print_varspec_suffix (struct type *type, struct ui_file *stream,
if (arrayprint_recurse_level == 1)
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
+ {
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);
@@ -189,6 +208,7 @@ f_type_print_varspec_suffix (struct type *type, struct ui_file *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);
+ }
if (arrayprint_recurse_level == 1)
fprintf_filtered (stream, ")");
else
diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
index ca86fbd..05cd795 100644
--- a/gdb/gdbtypes.c
+++ b/gdb/gdbtypes.c
@@ -1068,7 +1068,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;
@@ -1806,6 +1807,12 @@ is_dynamic_type_internal (struct type *type, int top_level)
|| TYPE_DATA_LOCATION_KIND (type) == PROP_LOCLIST))
return 1;
+ if (TYPE_ASSOCIATED_PROP (type))
+ return 1;
+
+ if (TYPE_ALLOCATED_PROP (type))
+ return 1;
+
switch (TYPE_CODE (type))
{
case TYPE_CODE_RANGE:
@@ -1923,6 +1930,8 @@ resolve_dynamic_array (struct type *type,
struct type *elt_type;
struct type *range_type;
struct type *ary_dim;
+ struct type *copy = copy_type (type);
+ struct dynamic_prop *prop;
gdb_assert (TYPE_CODE (type) == TYPE_CODE_ARRAY);
@@ -1930,16 +1939,30 @@ resolve_dynamic_array (struct type *type,
range_type = check_typedef (TYPE_INDEX_TYPE (elt_type));
range_type = resolve_dynamic_range (range_type, addr_stack);
+ /* Resolve allocated/associated here before creating a new array type, which
+ will update the length of the array accordingly. */
+ prop = TYPE_ALLOCATED_PROP (copy);
+ if (prop != NULL && dwarf2_evaluate_property (prop, addr_stack, &value))
+ {
+ TYPE_DYN_PROP_ADDR (prop) = value;
+ TYPE_DYN_PROP_KIND (prop) = PROP_CONST;
+ }
+ prop = TYPE_ASSOCIATED_PROP (copy);
+ if (prop != NULL && dwarf2_evaluate_property (prop, addr_stack, &value))
+ {
+ TYPE_DYN_PROP_ADDR (prop) = value;
+ TYPE_DYN_PROP_KIND (prop) = PROP_CONST;
+ }
+
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_stack);
+ elt_type = resolve_dynamic_array (TYPE_TARGET_TYPE (copy), addr_stack);
else
elt_type = TYPE_TARGET_TYPE (type);
- return create_array_type_with_stride (copy_type (type),
- elt_type, range_type,
- TYPE_FIELD_BITSIZE (type, 0));
+ return create_array_type_with_stride (copy,
+ elt_type, range_type, TYPE_FIELD_BITSIZE (type, 0));
}
/* Resolve dynamic bounds of members of the union TYPE to static
diff --git a/gdb/gdbtypes.h b/gdb/gdbtypes.h
index fd3bc0e..ebed54c 100644
--- a/gdb/gdbtypes.h
+++ b/gdb/gdbtypes.h
@@ -440,6 +440,16 @@ enum dynamic_prop_node_kind
/* A property providing a type's data location.
Evaluating this field yields to the location of an object's data. */
DYN_PROP_DATA_LOCATION,
+
+ /* A property representing DW_AT_allocated. The presence of this attribute
+ indicates that the object of the type can be allocated/deallocated.
+ The value can be a dwarf expression, reference, or a constant. */
+ DYN_PROP_ALLOCATED,
+
+ /* A property representing DW_AT_allocated. The presence of this attribute
+ indicated that the object of the type can be associated. The value can be
+ a dwarf expression, reference, or a constant.*/
+ DYN_PROP_ASSOCIATED,
};
/* * List for dynamic type attributes. */
@@ -1266,6 +1276,24 @@ extern void allocate_gnat_aux_type (struct type *);
#define TYPE_DATA_LOCATION_KIND(thistype) \
TYPE_DATA_LOCATION (thistype)->kind
+/* Property accessors for the type allocated/associated. */
+#define TYPE_ALLOCATED_PROP(thistype) \
+ get_dyn_prop (DYN_PROP_ALLOCATED, thistype)
+#define TYPE_ASSOCIATED_PROP(thistype) \
+ get_dyn_prop (DYN_PROP_ASSOCIATED, thistype)
+
+/* Allocated status of type object. If set to non-zero it means the object
+ is allocated. A zero value means it is not allocated. */
+#define TYPE_NOT_ALLOCATED(t) (TYPE_ALLOCATED_PROP (t) \
+ && TYPE_DYN_PROP_KIND (TYPE_ALLOCATED_PROP (t)) == PROP_CONST \
+ && !TYPE_DYN_PROP_ADDR (TYPE_ALLOCATED_PROP (t)))
+
+/* Associated status of type object. If set to non-zero it means the object
+ is associated. A zero value means it is not associated. */
+#define TYPE_NOT_ASSOCIATED(t) (TYPE_ASSOCIATED_PROP (t) \
+ && TYPE_DYN_PROP_KIND (TYPE_ASSOCIATED_PROP (t)) == PROP_CONST \
+ && !TYPE_DYN_PROP_ADDR (TYPE_ASSOCIATED_PROP (t)))
+
/* Attribute accessors for dynamic properties. */
#define TYPE_DYN_PROP_LIST(thistype) \
TYPE_MAIN_TYPE(thistype)->dyn_prop_list
diff --git a/gdb/valarith.c b/gdb/valarith.c
index df1e8c3..9c959b3 100644
--- a/gdb/valarith.c
+++ b/gdb/valarith.c
@@ -198,7 +198,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 294c6a8..55bd59f 100644
--- a/gdb/valprint.c
+++ b/gdb/valprint.c
@@ -303,6 +303,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)
@@ -359,6 +371,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
@@ -833,6 +857,18 @@ value_check_printable (struct value *val, struct ui_file *stream,
return 0;
}
+ if (TYPE_NOT_ASSOCIATED (value_type (val)))
+ {
+ val_print_not_associated (stream);
+ return 0;
+ }
+
+ if (TYPE_NOT_ALLOCATED (value_type (val)))
+ {
+ val_print_not_allocated (stream);
+ return 0;
+ }
+
return 1;
}
diff --git a/gdb/valprint.h b/gdb/valprint.h
index ed4964f..1210b83 100644
--- a/gdb/valprint.h
+++ b/gdb/valprint.h
@@ -232,4 +232,8 @@ extern void print_command_parse_format (const char **expp, const char *cmdname,
struct format_data *fmtp);
extern void print_value (struct value *val, const struct format_data *fmtp);
+extern void val_print_not_allocated (struct ui_file *stream);
+
+extern void val_print_not_associated (struct ui_file *stream);
+
#endif
--
1.7.9.5
More information about the Gdb-patches
mailing list