Re: [PATCH] Support for Fortran's ASSUMED RANK

[Andrew Burgess <aburgess@redhat.com>]

Thanks for working on this feature, having this in would be a great win!

I'm a little short on time, so I only took a quick look through - I'll
try to do a full review next week, however, I did have some initial
questions, which would help with my review, see inline below...

* Potharla, Rupesh via Gdb-patches <gdb-patches@sourceware.org> [2022-01-19 17:57:53 +0000]:

> [AMD Official Use Only]
> 
> Requesting to please review the attached patch.
> 
> 
> This patch adds support for debugging assumed rank arrays of Fortran.
> 
> Testcase used:
> 
> PROGRAM arank
> 
> REAL :: a1(10)
> 
> CALL sub1(a1)
> 
> CONTAINS
> SUBROUTINE sub1(a)
> REAL :: a(..)
> PRINT *, RANK(a)
> END
> END
> 
> Compiler Version:
> gcc (GCC) 12.0.0 20211122 (experimental)

I guess this must be something that was fixed recently, I tried with
the 9.3 compiler I have locally and the tests failed.  I also tried
with some random build from git from early last year, and that also
failed.

Ideally the tests wont just fail when using older tools, but instead
the test will detect that my compiler isn't good enough and just skip
the tests, so you might need to try with some older compilers.

> 
> Compilation command:
> gfortran assumedrank.f90 -gdwarf-5 -o assumedrank
> 
> Without Patch:
> 
> gdb -q assumedrank
> Reading symbols from assumedrank...
> (gdb) br sub1
> Breakpoint 1 at 0x4006ff: file assumedrank.f90, line 10.
> (gdb) r
> Starting program: /home/rupesh/STAGING-BUILD-2787/bin/assumedrank
> 
> Breakpoint 1, arank::sub1 (a=<unknown type in /home/rupesh/STAGING-BUILD-2787/bin/assumedrank, CU 0x0, DIE 0xd5>) at assumedrank.f90:10
> 10       PRINT *, RANK(a)
> (gdb) p RANK(a)
> 'a' has unknown type; cast it to its declared type
> 
> With patch :
> gdb -q assumedrank
> Reading symbols from assumedrank...
> (gdb) br sub1
> Breakpoint 1 at 0x4006ff: file assumedrank.f90, line 10.
> (gdb) r
> Starting program: /home/rupesh/STAGING-BUILD-2787/bin/assumedrank
> 
> Breakpoint 1, arank::sub1 (a=...) at assumedrank.f90:10
> 10       PRINT *, RANK(a)
> (gdb) p RANK(a)
> $1 = 1
> (gdb) ptype a
> type = real(kind=4) (10)
> (gdb)
> 
> Regards,
> Rupesh P
> 
> 


> From 383c561a1e926b7b65a1d8ffb5d70a047a4d4559 Mon Sep 17 00:00:00 2001
> From: rupesh <rupesh.potharla@amd.com>
> Date: Fri, 29 Oct 2021 11:32:58 +0530
> Subject: [PATCH] Support for Fortran's ASSUMED RANK.
> 
> This patch adds support for debugging assumed rank arrays of Fortran.
> 
> Testcase used:
> 
> PROGRAM arank
> 
> REAL :: a1(10)
> 
> CALL sub1(a1)
> 
> CONTAINS
> SUBROUTINE sub1(a)
> REAL :: a(..)
> PRINT *, RANK(a)
> END
> END
> 
> Compiler Version:
> gcc (GCC) 12.0.0 20211122 (experimental)
> 
> Compilation command:
> gfortran assumedrank.f90 -gdwarf-5 -o assumedrank
> 
> Without Patch:
> 
> gdb -q assumedrank
> Reading symbols from assumedrank...
> (gdb) br sub1
> Breakpoint 1 at 0x4006ff: file assumedrank.f90, line 10.
> (gdb) r
> Starting program: /home/rupesh/STAGING-BUILD-2787/bin/assumedrank
> 
> Breakpoint 1, arank::sub1 (a=<unknown type in /home/rupesh/STAGING-BUILD-2787/bin/assumedrank, CU 0x0, DIE 0xd5>) at assumedrank.f90:10
> 10       PRINT *, RANK(a)
> (gdb) p RANK(a)
> 'a' has unknown type; cast it to its declared type
> 
> With patch :
> gdb -q assumedrank
> Reading symbols from assumedrank...
> (gdb) br sub1
> Breakpoint 1 at 0x4006ff: file assumedrank.f90, line 10.
> (gdb) r
> Starting program: /home/rupesh/STAGING-BUILD-2787/bin/assumedrank
> 
> Breakpoint 1, arank::sub1 (a=...) at assumedrank.f90:10
> 10       PRINT *, RANK(a)
> (gdb) p RANK(a)
> $1 = 1
> (gdb) ptype a
> type = real(kind=4) (10)
> (gdb)
> 
> gdb/ChangeLog:
> 
> 	* dwarf2/loc.c: (dwarf2_locexpr_baton_eval): Push array dimension onto the stack.
> 	* dwarf2/loc.h: Added an additional parameter to the function dwarf2_evaluate_property.
> 	* dwarf2/read.c: (scan_partial_symbols): Process DW_TAG_generic_subrange.
> 	* (add_partial_symbol): Process DW_TAG_generic_subrange.
> 	* (process_die): Process DW_TAG_generic_subrange.
> 	* (is_type_tag_for_partial) : Check for DW_TAG_generic_subrange type.
> 	* (load_partial_dies): Load DW_TAG_generic_subrange.
> 	* (new_symbol): Create entry for DW_TAG_generic_subrange type.
> 	* (read_type_die_1): Read DW_TAG_generic_subrange type.
> 	* (set_die_type) : Add dynamic property type for DW_AT_rank.
> 	* f-typeprint.c: (f_type_print_varspec_suffix): Removed TYPE_DATA_LOCATION.
> 	* findvar.c: (follow_static_link): Passing new argument to the function call dwarf2_evaluate_property.
> 	* gdbtypes.c: (resolve_dynamic_range): Passing new argument to the function call dwarf2_evaluate_property.
> 	* (resolve_dynamic_array_or_string): Handle rank dynamic property by creating and removing types.
> 	* gdbtypes.h: (DYN_PROP_RANK, TYPE_DYN_PROP,  TYPE_RANK_PROP): New Macros
> 	* gnu-v3-abi.c: Passing new argument to the function call dwarf2_evaluate_property.
> 	* testsuite/gdb.fortran/assumedrank.exp: New Testcase
> 	* testsuite/gdb.fortran/assumedrank.f90: New Testcase

ChangeLog entries are no longer needed for GDB, though you are welcome
to have content like this in the commit message if you like.  That
said, the preference in GDB is to have the commit described within the
main body of the commit message - a ChangeLog formatted block should
be in addition.

You should still keep the lines under ~76ish characters though.

> ---
>  gdb/dwarf2/loc.c                          | 10 ++-
>  gdb/dwarf2/loc.h                          |  4 ++
>  gdb/dwarf2/read.c                         | 19 +++++-
>  gdb/f-typeprint.c                         |  4 +-
>  gdb/findvar.c                             |  2 +-
>  gdb/gdbtypes.c                            | 59 +++++++++++++----
>  gdb/gdbtypes.h                            |  7 ++
>  gdb/gnu-v3-abi.c                          |  2 +-
>  gdb/testsuite/gdb.fortran/assumedrank.exp | 79 +++++++++++++++++++++++
>  gdb/testsuite/gdb.fortran/assumedrank.f90 | 42 ++++++++++++
>  10 files changed, 209 insertions(+), 19 deletions(-)
>  create mode 100644 gdb/testsuite/gdb.fortran/assumedrank.exp
>  create mode 100644 gdb/testsuite/gdb.fortran/assumedrank.f90
> 
> diff --git a/gdb/dwarf2/loc.c b/gdb/dwarf2/loc.c
> index 182f15e7077..60f831c2cff 100644
> --- a/gdb/dwarf2/loc.c
> +++ b/gdb/dwarf2/loc.c
> @@ -1547,7 +1547,8 @@ dwarf2_locexpr_baton_eval (const struct dwarf2_locexpr_baton *dlbaton,
>  			   const struct property_addr_info *addr_stack,
>  			   CORE_ADDR *valp,
>  			   bool push_initial_value,
> -			   bool *is_reference)
> +			   bool *is_reference,
> +			   int rank)
>  {
>    if (dlbaton == NULL || dlbaton->size == 0)
>      return 0;
> @@ -1559,6 +1560,10 @@ dwarf2_locexpr_baton_eval (const struct dwarf2_locexpr_baton *dlbaton,
>    value *result;
>    scoped_value_mark free_values;
>  
> +  /* push rank value to the stack */
> +  if (rank)
> +     ctx.push_address((rank - 1), false);
> +

I wonder, did you consider making use of the push_initial_value
mechanism?

>    if (push_initial_value)
>      {
>        if (addr_stack != nullptr)
> @@ -1611,6 +1616,7 @@ dwarf2_evaluate_property (const struct dynamic_prop *prop,
>  			  struct frame_info *frame,
>  			  const struct property_addr_info *addr_stack,
>  			  CORE_ADDR *value,
> +			  int rank,
>  			  bool push_initial_value)
>  {
>    if (prop == NULL)
> @@ -1629,7 +1635,7 @@ dwarf2_evaluate_property (const struct dynamic_prop *prop,
>  
>  	bool is_reference = baton->locexpr.is_reference;
>  	if (dwarf2_locexpr_baton_eval (&baton->locexpr, frame, addr_stack,
> -				       value, push_initial_value, &is_reference))
> +				       value, push_initial_value, &is_reference, rank))
>  	  {
>  	    if (is_reference)
>  	      {
> diff --git a/gdb/dwarf2/loc.h b/gdb/dwarf2/loc.h
> index 5ff061bb4b6..66b35876da1 100644
> --- a/gdb/dwarf2/loc.h
> +++ b/gdb/dwarf2/loc.h
> @@ -114,6 +114,9 @@ struct property_addr_info
>     Returns true if PROP could be converted and the static value is passed
>     back into VALUE, otherwise returns false.
>  
> +   rank is pushed on to the stack before evaluating assumed rank array
> +   dimensions.
> +
>     If PUSH_INITIAL_VALUE is true, then the top value of ADDR_STACK
>     will be pushed before evaluating a location expression.  */
>  
> @@ -121,6 +124,7 @@ bool dwarf2_evaluate_property (const struct dynamic_prop *prop,
>  			       struct frame_info *frame,
>  			       const struct property_addr_info *addr_stack,
>  			       CORE_ADDR *value,
> +			       int rank,
>  			       bool push_initial_value = false);
>  
>  /* A helper for the compiler interface that compiles a single dynamic
> diff --git a/gdb/dwarf2/read.c b/gdb/dwarf2/read.c
> index f2d7da7de52..05e1bc9c6c2 100644
> --- a/gdb/dwarf2/read.c
> +++ b/gdb/dwarf2/read.c
> @@ -7694,6 +7694,7 @@ scan_partial_symbols (struct partial_die_info *first_die, CORE_ADDR *lowpc,
>  		add_partial_enumeration (pdi, cu);
>  	      break;
>  	    case DW_TAG_base_type:
> +	    case DW_TAG_generic_subrange:
>  	    case DW_TAG_subrange_type:
>  	      /* File scope base type definitions are added to the partial
>  		 symbol table.  */
> @@ -8020,6 +8021,7 @@ add_partial_symbol (struct partial_die_info *pdi, struct dwarf2_cu *cu)
>      case DW_TAG_typedef:
>      case DW_TAG_base_type:
>      case DW_TAG_subrange_type:
> +    case DW_TAG_generic_subrange:
>        psymbol.domain = VAR_DOMAIN;
>        psymbol.aclass = LOC_TYPEDEF;
>        where = psymbol_placement::STATIC;
> @@ -9721,6 +9723,7 @@ process_die (struct die_info *die, struct dwarf2_cu *cu)
>        /* FALLTHROUGH */
>      case DW_TAG_base_type:
>      case DW_TAG_subrange_type:
> +    case DW_TAG_generic_subrange:
>      case DW_TAG_typedef:
>        /* Add a typedef symbol for the type definition, if it has a
>  	 DW_AT_name.  */
> @@ -16612,7 +16615,8 @@ read_array_type (struct die_info *die, struct dwarf2_cu *cu)
>    child_die = die->child;
>    while (child_die && child_die->tag)
>      {
> -      if (child_die->tag == DW_TAG_subrange_type)
> +      if (child_die->tag == DW_TAG_subrange_type
> +          || child_die->tag == DW_TAG_generic_subrange)
>  	{
>  	  struct type *child_type = read_type_die (child_die, cu);
>  
> @@ -18934,6 +18938,7 @@ is_type_tag_for_partial (int tag, enum language lang)
>      case DW_TAG_enumeration_type:
>      case DW_TAG_structure_type:
>      case DW_TAG_subrange_type:
> +    case DW_TAG_generic_subrange:
>      case DW_TAG_typedef:
>      case DW_TAG_union_type:
>        return 1;
> @@ -19067,6 +19072,7 @@ load_partial_dies (const struct die_reader_specs *reader,
>  	  && ((pdi.tag == DW_TAG_typedef && !pdi.has_children)
>  	      || pdi.tag == DW_TAG_base_type
>  	      || pdi.tag == DW_TAG_array_type
> +	      || pdi.tag == DW_TAG_generic_subrange
>  	      || pdi.tag == DW_TAG_subrange_type))
>  	{
>  	  if (building_psymtab && pdi.raw_name != NULL)
> @@ -21989,6 +21995,7 @@ new_symbol (struct die_info *die, struct type *type, struct dwarf2_cu *cu,
>  	case DW_TAG_array_type:
>  	case DW_TAG_base_type:
>  	case DW_TAG_subrange_type:
> +	case DW_TAG_generic_subrange:
>  	  SYMBOL_ACLASS_INDEX (sym) = LOC_TYPEDEF;
>  	  SYMBOL_DOMAIN (sym) = VAR_DOMAIN;
>  	  list_to_add = cu->list_in_scope;
> @@ -22482,6 +22489,7 @@ read_type_die_1 (struct die_info *die, struct dwarf2_cu *cu)
>      case DW_TAG_typedef:
>        this_type = read_typedef (die, cu);
>        break;
> +    case DW_TAG_generic_subrange:
>      case DW_TAG_subrange_type:
>        this_type = read_subrange_type (die, cu);
>        break;
> @@ -24767,6 +24775,15 @@ set_die_type (struct die_info *die, struct type *type, struct dwarf2_cu *cu,
>  	type->add_dyn_prop (DYN_PROP_ASSOCIATED, prop);
>      }
>  
> +  /* Read DW_AT_rank and set in type */
> +  attr = dwarf2_attr (die, DW_AT_rank, cu);
> +  if (attr != NULL)
> +    {
> +      struct type *prop_type = cu->addr_sized_int_type (false);
> +      if (attr_to_dynamic_prop (attr, die, cu, &prop, prop_type))
> +	type->add_dyn_prop (DYN_PROP_RANK, prop);
> +    }
> +
>    /* Read DW_AT_data_location and set in type.  */
>    if (!skip_data_location)
>      {
> diff --git a/gdb/f-typeprint.c b/gdb/f-typeprint.c
> index 1791cb29451..95500e930ba 100644
> --- a/gdb/f-typeprint.c
> +++ b/gdb/f-typeprint.c
> @@ -177,9 +177,7 @@ f_language::f_type_print_varspec_suffix (struct type *type,
>        else if ((TYPE_ASSOCIATED_PROP (type)
>  		&& PROP_CONST != TYPE_ASSOCIATED_PROP (type)->kind ())
>  	       || (TYPE_ALLOCATED_PROP (type)
> -		   && PROP_CONST != TYPE_ALLOCATED_PROP (type)->kind ())
> -	       || (TYPE_DATA_LOCATION (type)
> -		   && PROP_CONST != TYPE_DATA_LOCATION (type)->kind ()))
> +		   && PROP_CONST != TYPE_ALLOCATED_PROP (type)->kind ()))
>  	{
>  	  /* This case exist when we ptype a typename which has the dynamic
>  	     properties but cannot be resolved as there is no object.  */
> diff --git a/gdb/findvar.c b/gdb/findvar.c
> index a0031d2dadd..a1c25323bc6 100644
> --- a/gdb/findvar.c
> +++ b/gdb/findvar.c
> @@ -440,7 +440,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, 0))
>      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 00934d9a4bc..227b7af2c1b 100644
> --- a/gdb/gdbtypes.c
> +++ b/gdb/gdbtypes.c
> @@ -2196,6 +2196,7 @@ static struct type *resolve_dynamic_type_internal
>  static struct type *
>  resolve_dynamic_range (struct type *dyn_range_type,
>  		       struct property_addr_info *addr_stack,
> +		       int curr_rank,
>  		       bool resolve_p = true)
>  {
>    CORE_ADDR value;
> @@ -2205,13 +2206,13 @@ resolve_dynamic_range (struct type *dyn_range_type,
>    gdb_assert (dyn_range_type->code () == TYPE_CODE_RANGE);
>  
>    const struct dynamic_prop *prop = &dyn_range_type->bounds ()->low;
> -  if (resolve_p && dwarf2_evaluate_property (prop, NULL, addr_stack, &value))
> +  if (resolve_p && dwarf2_evaluate_property (prop, NULL, addr_stack, &value, curr_rank))
>      low_bound.set_const_val (value);
>    else
>      low_bound.set_undefined ();
>  
>    prop = &dyn_range_type->bounds ()->high;
> -  if (resolve_p && dwarf2_evaluate_property (prop, NULL, addr_stack, &value))
> +  if (resolve_p && dwarf2_evaluate_property (prop, NULL, addr_stack, &value, curr_rank))
>      {
>        high_bound.set_const_val (value);
>  
> @@ -2224,7 +2225,7 @@ resolve_dynamic_range (struct type *dyn_range_type,
>  
>    bool byte_stride_p = dyn_range_type->bounds ()->flag_is_byte_stride;
>    prop = &dyn_range_type->bounds ()->stride;
> -  if (resolve_p && dwarf2_evaluate_property (prop, NULL, addr_stack, &value))
> +  if (resolve_p && dwarf2_evaluate_property (prop, NULL, addr_stack, &value, curr_rank))
>      {
>        stride.set_const_val (value);
>  
> @@ -2272,8 +2273,12 @@ resolve_dynamic_array_or_string (struct type *type,
>    struct type *elt_type;
>    struct type *range_type;
>    struct type *ary_dim;
> +  struct type *tmp_type;
> +  struct type *element_type;
>    struct dynamic_prop *prop;
>    unsigned int bit_stride = 0;
> +  unsigned int i;
> +  static int rank = 0;
>  
>    /* For dynamic type resolution strings can be treated like arrays of
>       characters.  */
> @@ -2293,7 +2298,7 @@ resolve_dynamic_array_or_string (struct type *type,
>       dimension of the array.  */
>    prop = TYPE_ALLOCATED_PROP (type);
>    if (prop != NULL && resolve_p
> -      && dwarf2_evaluate_property (prop, NULL, addr_stack, &value))
> +      && dwarf2_evaluate_property (prop, NULL, addr_stack, &value, 0))
>      {
>        prop->set_const_val (value);
>        if (value == 0)
> @@ -2302,15 +2307,47 @@ resolve_dynamic_array_or_string (struct type *type,
>  
>    prop = TYPE_ASSOCIATED_PROP (type);
>    if (prop != NULL && resolve_p
> -      && dwarf2_evaluate_property (prop, NULL, addr_stack, &value))
> +      && dwarf2_evaluate_property (prop, NULL, addr_stack, &value, 0))
>      {
>        prop->set_const_val (value);
>        if (value == 0)
>  	resolve_p = false;
>      }
>  
> +  /* Resolve the rank property to get rank value. If rank is zero or is of
> +     variable type remove the array type from the linked list. If the rank
> +     is greater than 1 add more array types to the list based on rank value
> +     to hold multi dimensional array information.   */
> +  prop = TYPE_RANK_PROP (type);
> +  if (!rank && prop != NULL && resolve_p
> +     &&  dwarf2_evaluate_property (prop, NULL, addr_stack, &value, 0))
> +    {
> +      prop->set_const_val (value);
> +      if (value == 0)
> +      {
> +	resolve_p = false;
> +	TYPE_DYN_PROP(TYPE_TARGET_TYPE(type)) = TYPE_DYN_PROP(type);
> +	type = TYPE_TARGET_TYPE(type);
> +	return type;
> +      }
> +      else
> +      {
> +        rank = value;
> +        tmp_type = type;
> +        element_type = TYPE_TARGET_TYPE(tmp_type);
> +        for (i = 1; i < rank; i++)
> +        {
> +          TYPE_TARGET_TYPE(tmp_type) = copy_type(tmp_type);
> +          tmp_type = TYPE_TARGET_TYPE(tmp_type);
> +        }
> +        TYPE_TARGET_TYPE(tmp_type) = element_type;
> +      }
> +    }
> +
>    range_type = check_typedef (type->index_type ());
> -  range_type = resolve_dynamic_range (range_type, addr_stack, resolve_p);
> +  range_type = resolve_dynamic_range (range_type, addr_stack, rank, resolve_p);
> +  if (rank)
> +    rank--;
>  
>    ary_dim = check_typedef (TYPE_TARGET_TYPE (type));
>    if (ary_dim != NULL && ary_dim->code () == TYPE_CODE_ARRAY)
> @@ -2321,7 +2358,7 @@ resolve_dynamic_array_or_string (struct type *type,
>    prop = type->dyn_prop (DYN_PROP_BYTE_STRIDE);
>    if (prop != NULL && resolve_p)
>      {
> -      if (dwarf2_evaluate_property (prop, NULL, addr_stack, &value))
> +      if (dwarf2_evaluate_property (prop, NULL, addr_stack,  &value, 0))
>  	{
>  	  type->remove_dyn_prop (DYN_PROP_BYTE_STRIDE);
>  	  bit_stride = (unsigned int) (value * 8);
> @@ -2597,7 +2634,7 @@ resolve_dynamic_struct (struct type *type,
>  	  prop.set_locexpr (&baton);
>  
>  	  CORE_ADDR addr;
> -	  if (dwarf2_evaluate_property (&prop, nullptr, addr_stack, &addr,
> +	  if (dwarf2_evaluate_property (&prop, nullptr, addr_stack, &addr, 0,
>  					true))
>  	    resolved_type->field (i).set_loc_bitpos
>  	      (TARGET_CHAR_BIT * (addr - addr_stack->addr));
> @@ -2682,7 +2719,7 @@ resolve_dynamic_type_internal (struct type *type,
>    gdb::optional<CORE_ADDR> type_length;
>    prop = TYPE_DYNAMIC_LENGTH (type);
>    if (prop != NULL
> -      && dwarf2_evaluate_property (prop, NULL, addr_stack, &value))
> +      && dwarf2_evaluate_property (prop, NULL, addr_stack, &value, 0))
>      type_length = value;
>  
>    if (type->code () == TYPE_CODE_TYPEDEF)
> @@ -2727,7 +2764,7 @@ resolve_dynamic_type_internal (struct type *type,
>  	  break;
>  
>  	case TYPE_CODE_RANGE:
> -	  resolved_type = resolve_dynamic_range (type, addr_stack);
> +	  resolved_type = resolve_dynamic_range (type, addr_stack, 0);
>  	  break;
>  
>  	case TYPE_CODE_UNION:
> @@ -2752,7 +2789,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, 0))
>      {
>        /* Start of Fortran hack.  See comment in f-lang.h for what is going
>  	 on here.*/
> diff --git a/gdb/gdbtypes.h b/gdb/gdbtypes.h
> index 5284a4c3a03..374f7e9e1f6 100644
> --- a/gdb/gdbtypes.h
> +++ b/gdb/gdbtypes.h
> @@ -556,6 +556,10 @@ enum dynamic_prop_node_kind
>    /* A property holding variant parts.  */
>    DYN_PROP_VARIANT_PARTS,
>  
> +  /* A property representing DW_AT_rank. The presence of this attribute
> +     indicates that the object is of assumed rank array type.  */
> +  DYN_PROP_RANK,
> +
>    /* A property holding the size of the type.  */
>    DYN_PROP_BYTE_SIZE,
>  };
> @@ -2035,6 +2039,7 @@ extern void allocate_gnat_aux_type (struct type *);
>  #define TYPE_REFERENCE_TYPE(thistype) (thistype)->reference_type
>  #define TYPE_RVALUE_REFERENCE_TYPE(thistype) (thistype)->rvalue_reference_type
>  #define TYPE_CHAIN(thistype) (thistype)->chain
> +#define TYPE_DYN_PROP(thistype)  TYPE_MAIN_TYPE(thistype)->dyn_prop_list
>  /* * Note that if thistype is a TYPEDEF type, you have to call check_typedef.
>     But check_typedef does set the TYPE_LENGTH of the TYPEDEF type,
>     so you only have to call check_typedef once.  Since allocate_value
> @@ -2077,6 +2082,8 @@ extern bool set_type_align (struct type *, ULONGEST);
>    ((thistype)->dyn_prop (DYN_PROP_ALLOCATED))
>  #define TYPE_ASSOCIATED_PROP(thistype) \
>    ((thistype)->dyn_prop (DYN_PROP_ASSOCIATED))
> +#define TYPE_RANK_PROP(thistype) \
> +  ((thistype)->dyn_prop (DYN_PROP_RANK))
>  
>  /* C++ */
>  
> diff --git a/gdb/gnu-v3-abi.c b/gdb/gnu-v3-abi.c
> index 187c10595ac..e42e20148f4 100644
> --- a/gdb/gnu-v3-abi.c
> +++ b/gdb/gnu-v3-abi.c
> @@ -483,7 +483,7 @@ gnuv3_baseclass_offset (struct type *type, int index,
>  
>        CORE_ADDR result;
>        if (dwarf2_evaluate_property (&prop, nullptr, &addr_stack, &result,
> -				    true))
> +				    0, true))
>  	return (int) (result - addr_stack.addr);
>      }
>  
> diff --git a/gdb/testsuite/gdb.fortran/assumedrank.exp b/gdb/testsuite/gdb.fortran/assumedrank.exp
> new file mode 100644
> index 00000000000..e3961d00278
> --- /dev/null
> +++ b/gdb/testsuite/gdb.fortran/assumedrank.exp
> @@ -0,0 +1,79 @@
> +# Copyright 2021 Free Software Foundation, Inc.
> +
> +# This program is free software; you can redistribute it and/or modify
> +# it under the terms of the GNU General Public License as published by
> +# the Free Software Foundation; either version 3 of the License, or
> +# (at your option) any later version.
> +#
> +# This program is distributed in the hope that it will be useful,
> +# but WITHOUT ANY WARRANTY; without even the implied warranty of
> +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
> +# GNU General Public License for more details.
> +#
> +# You should have received a copy of the GNU General Public License
> +# along with this program.  If not, see <http://www.gnu.org/licenses/> .
> +
> +# Testing GDB's implementation of ASSUMED RANK.
> +
> +if {[skip_fortran_tests]} { return -1 }
> +
> +standard_testfile ".f90"
> +load_lib fortran.exp
> +
> +if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
> +	 {debug f90}]} {

In your commit message you made use of the -dwarf-5 flag.  Is that
required?  I was surprised that this flag doesn't appear here.
There's a couple of tests where we pass 'additional_flags=-gdwarf-5',
but you might only need to do this if the compiler is gfortran, and
maybe for particular versions?

I'll try to take a detailed look through next week.

Thanks,
Andrew


> +    return -1
> +}
> +
> +if ![fortran_runto_main] {
> +    untested "could not run to main"
> +    return -1
> +}
> +
> +gdb_breakpoint [gdb_get_line_number "Test Breakpoint"]
> +gdb_breakpoint [gdb_get_line_number "Final Breakpoint"]
> +
> +# We place a limit on the number of tests that can be run, just in
> +# case something goes wrong, and GDB gets stuck in an loop here.
> +set found_final_breakpoint false
> +set test_count 0
> +while { $test_count < 500 } {
> +    with_test_prefix "test $test_count" {
> +	incr test_count
> +
> +	gdb_test_multiple "continue" "continue" {
> +	    -re -wrap "! Test Breakpoint" {
> +		# We can run a test from here.
> +	    }
> +	    -re "! Final Breakpoint" {
> +		# We're done with the tests.
> +		set found_final_breakpoint true
> +	    }
> +	}
> +
> +	if ($found_final_breakpoint) {
> +	    break
> +	}
> +
> +	# First grab the expected answer.
> +	set answer [get_valueof "" "rank(answer)" "**unknown**"]
> +
> +	# Now move up a frame and figure out a command for us to run
> +	# as a test.
> +	set command ""
> +	gdb_test_multiple "up" "up" {
> +	-re -wrap "\r\n\[0-9\]+\[ \t\]+call test_rank (\[^\r\n\]+)" {
> +		set command $expect_out(1,string)
> +	    }
> +	}
> +
> +	gdb_assert { ![string equal $command ""] } "found a command to run"
> +
> +	gdb_test "p rank($command)" " = ($answer)"
> +    }
> +}
> +
> +# Ensure we reached the final breakpoint.  If more tests have been added
> +# to the test script, and this starts failing, then the safety 'while'
> +# loop above might need to be increased.
> +gdb_assert {$found_final_breakpoint} "ran all compiled in tests"
> diff --git a/gdb/testsuite/gdb.fortran/assumedrank.f90 b/gdb/testsuite/gdb.fortran/assumedrank.f90
> new file mode 100644
> index 00000000000..53b4d7fc35d
> --- /dev/null
> +++ b/gdb/testsuite/gdb.fortran/assumedrank.f90
> @@ -0,0 +1,42 @@
> +! Copyright 2021 Free Software Foundation, Inc.
> +!
> +! This program is free software; you can redistribute it and/or modify
> +! it under the terms of the GNU General Public License as published by
> +! the Free Software Foundation; either version 3 of the License, or
> +! (at your option) any later version.
> +!
> +! This program is distributed in the hope that it will be useful,
> +! but WITHOUT ANY WARRANTY; without even the implied warranty of
> +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
> +! GNU General Public License for more details.
> +!
> +! You should have received a copy of the GNU General Public License
> +! along with this program.  If not, see <http://www.gnu.org/licenses/>.
> +
> +!
> +! Start of test program.
> +!
> +
> +
> +PROGRAM  arank
> +
> +REAL :: array1(10)
> +REAL :: array2(1, 2)
> +REAL :: array3(3, 4, 5)
> +REAL :: array4(4, 5, 6, 7)
> +
> +call test_rank (array1)
> +call test_rank (array2)
> +call test_rank (array3)
> +call test_rank (array4)
> +
> +print *, "" ! Final Breakpoint
> +
> +CONTAINS
> +  SUBROUTINE test_rank(answer)
> +    REAL :: answer(..)
> +    print *, RANK(answer)     ! Test Breakpoint
> +  END
> +
> +END PROGRAM arank
> +
> -- 
> 2.17.1