This is the mail archive of the
gdb-patches@sourceware.org
mailing list for the GDB project.
[V3 02/21] vla: make dynamic fortran arrays functional.
- From: Keven Boell <keven dot boell at intel dot com>
- To: gdb-patches at sourceware dot org
- Cc: sanimir dot agovic at intel dot com, Keven Boell <keven dot boell at intel dot com>
- Date: Wed, 10 Sep 2014 11:21:50 +0200
- Subject: [V3 02/21] vla: make dynamic fortran arrays functional.
- Authentication-results: sourceware.org; auth=none
- References: <1410340929-20653-1-git-send-email-keven dot boell at intel dot com>
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.
* 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.
---
gdb/dwarf2loc.c | 19 ++++++++++
gdb/dwarf2loc.h | 6 ++++
gdb/f-typeprint.c | 62 +++++++++++++++++++++------------
gdb/gdbtypes.c | 99 ++++++++++++++++++++++++++++++++++++++++++++++++++---
gdb/valarith.c | 9 ++++-
gdb/valprint.c | 40 ++++++++++++++++++++++
gdb/valprint.h | 4 +++
gdb/value.c | 20 +++++++++++
8 files changed, 232 insertions(+), 27 deletions(-)
diff --git a/gdb/dwarf2loc.c b/gdb/dwarf2loc.c
index e347e59..ad33078 100644
--- a/gdb/dwarf2loc.c
+++ b/gdb/dwarf2loc.c
@@ -2285,6 +2285,11 @@ dwarf2_evaluate_loc_desc_full (struct type *type, struct frame_info *frame,
int in_stack_memory = dwarf_expr_fetch_in_stack_memory (ctx, 0);
do_cleanups (value_chain);
+
+ /* Select right frame to correctly evaluate VLA's during a backtrace. */
+ if (is_dynamic_type (type))
+ select_frame (frame);
+
retval = value_at_lazy (type, address + byte_offset);
if (in_stack_memory)
set_value_stack (retval, 1);
@@ -2508,6 +2513,20 @@ dwarf2_evaluate_property (const struct dynamic_prop *prop,
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 96925e4..e04dca5 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 7474051..be719c6 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,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')
@@ -167,28 +179,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 1326f85..9653c6f 100644
--- a/gdb/gdbtypes.c
+++ b/gdb/gdbtypes.c
@@ -1001,7 +1001,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;
@@ -1614,6 +1615,11 @@ stub_noname_complaint (void)
static int
is_dynamic_type_internal (struct type *type, int top_level)
{
+ int index;
+
+ if (!type)
+ return 0;
+
type = check_typedef (type);
/* We only want to recognize references at the outermost level. */
@@ -1631,6 +1637,20 @@ 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;
+
+ /* 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:
@@ -1686,6 +1706,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);
@@ -1717,8 +1738,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;
@@ -1735,6 +1756,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);
@@ -1742,14 +1765,28 @@ 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);
}
@@ -4142,6 +4179,20 @@ copy_type_recursive (struct objfile *objfile,
sizeof (struct dynamic_prop));
}
+ /* 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) =
@@ -4195,6 +4246,44 @@ copy_type (const struct type *type)
sizeof (struct dynamic_prop));
}
+ 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 44673a1..2f3b58a 100644
--- a/gdb/valarith.c
+++ b/gdb/valarith.c
@@ -199,7 +199,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 8cb5c74..5794bad 100644
--- a/gdb/valprint.c
+++ b/gdb/valprint.c
@@ -304,6 +304,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)
@@ -360,6 +372,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
@@ -801,12 +825,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)))
@@ -832,6 +860,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 077d234..4ed70e7 100644
--- a/gdb/value.c
+++ b/gdb/value.c
@@ -41,6 +41,7 @@
#include "tracepoint.h"
#include "cp-abi.h"
#include "user-regs.h"
+#include "dwarf2loc.h"
/* Prototypes for exported functions. */
@@ -1732,6 +1733,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