* [PATCH] Support for Fortran's ASSUMED RANK
@ 2022-01-19 17:57 Potharla, Rupesh
2022-01-21 19:07 ` Andrew Burgess
0 siblings, 1 reply; 15+ messages in thread
From: Potharla, Rupesh @ 2022-01-19 17:57 UTC (permalink / raw)
To: gdb-patches
Cc: George, Jini Susan, Parasuraman, Hariharan, Sharma, Alok Kumar,
Achra, Nitika, Kumar N, Bhuvanendra, Natarajan, Kavitha,
Balasubrmanian, Vignesh, E, Nagajyothi, Kaushik, Sharang
[-- Attachment #1: Type: text/plain, Size: 1302 bytes --]
[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)
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
[-- Attachment #2: 0001-Support-for-Fortran-s-ASSUMED-RANK.patch --]
[-- Type: application/octet-stream, Size: 21960 bytes --]
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
---
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);
+
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}]} {
+ 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
^ permalink raw reply [flat|nested] 15+ messages in thread
* Re: [PATCH] Support for Fortran's ASSUMED RANK
2022-01-19 17:57 [PATCH] Support for Fortran's ASSUMED RANK Potharla, Rupesh
@ 2022-01-21 19:07 ` Andrew Burgess
2022-01-22 7:17 ` Potharla, Rupesh
2022-01-28 7:49 ` Potharla, Rupesh
0 siblings, 2 replies; 15+ messages in thread
From: Andrew Burgess @ 2022-01-21 19:07 UTC (permalink / raw)
To: Potharla, Rupesh
Cc: gdb-patches, Achra, Nitika, Kaushik, Sharang, Natarajan, Kavitha,
E, Nagajyothi, Kumar N, Bhuvanendra, George, Jini Susan,
Parasuraman, Hariharan, Sharma, Alok Kumar, Balasubrmanian,
Vignesh
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
^ permalink raw reply [flat|nested] 15+ messages in thread
* RE: [PATCH] Support for Fortran's ASSUMED RANK
2022-01-21 19:07 ` Andrew Burgess
@ 2022-01-22 7:17 ` Potharla, Rupesh
2022-01-28 7:49 ` Potharla, Rupesh
1 sibling, 0 replies; 15+ messages in thread
From: Potharla, Rupesh @ 2022-01-22 7:17 UTC (permalink / raw)
To: Andrew Burgess
Cc: gdb-patches, Achra, Nitika, Kaushik, Sharang, Natarajan, Kavitha,
E, Nagajyothi, Kumar N, Bhuvanendra, George, Jini Susan,
Parasuraman, Hariharan, Sharma, Alok Kumar, Balasubrmanian,
Vignesh
[AMD Official Use Only]
Hi Andrew,
Thanks for the prompt. While working on this, I saw issues with gcc compiler so I opened a gcc ticket (https://gcc.gnu.org/bugzilla/show_bug.cgi?id=103315 )which recently fixed the issues with the compiler.
Regards,
Rupesh P
-----Original Message-----
From: Andrew Burgess <aburgess@redhat.com>
Sent: Saturday, January 22, 2022 12:37 AM
To: Potharla, Rupesh <Rupesh.Potharla@amd.com>
Cc: gdb-patches@sourceware.org; Achra, Nitika <Nitika.Achra@amd.com>; Kaushik, Sharang <Sharang.Kaushik@amd.com>; Natarajan, Kavitha <Kavitha.Natarajan@amd.com>; E, Nagajyothi <Nagajyothi.E@amd.com>; Kumar N, Bhuvanendra <Bhuvanendra.KumarN@amd.com>; George, Jini Susan <JiniSusan.George@amd.com>; Parasuraman, Hariharan <Hariharan.Parasuraman@amd.com>; Sharma, Alok Kumar <AlokKumar.Sharma@amd.com>; Balasubrmanian, Vignesh <Vignesh.Balasubrmanian@amd.com>
Subject: Re: [PATCH] Support for Fortran's ASSUMED RANK
[CAUTION: External Email]
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 <https://nam11.safelinks.protection.outlook.com/?url=http%3A%2F%2Fwww.gnu.org%2Flicenses%2F&data=04%7C01%7Crupesh.potharla%40amd.com%7Cc481b41f3aa843656da008d9dd113ffe%7C3dd8961fe4884e608e11a82d994e183d%7C0%7C0%7C637783888447831759%7CUnknown%7CTWFpbGZsb3d8eyJWIjoiMC4wLjAwMDAiLCJQIjoiV2luMzIiLCJBTiI6Ik1haWwiLCJXVCI6Mn0%3D%7C3000&sdata=qcvs2DAFdVDL3s7Evqm5v6cr8%2FzI1WZ%2BHtvf1Mq39XA%3D&reserved=0> .
> +
> +# 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 <https://nam11.safelinks.protection.outlook.com/?url=http%3A%2F%2Fwww.gnu.org%2Flicenses%2F&data=04%7C01%7Crupesh.potharla%40amd.com%7Cc481b41f3aa843656da008d9dd113ffe%7C3dd8961fe4884e608e11a82d994e183d%7C0%7C0%7C637783888447831759%7CUnknown%7CTWFpbGZsb3d8eyJWIjoiMC4wLjAwMDAiLCJQIjoiV2luMzIiLCJBTiI6Ik1haWwiLCJXVCI6Mn0%3D%7C3000&sdata=qcvs2DAFdVDL3s7Evqm5v6cr8%2FzI1WZ%2BHtvf1Mq39XA%3D&reserved=0>.
> +
> +!
> +! 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
^ permalink raw reply [flat|nested] 15+ messages in thread
* RE: [PATCH] Support for Fortran's ASSUMED RANK
2022-01-21 19:07 ` Andrew Burgess
2022-01-22 7:17 ` Potharla, Rupesh
@ 2022-01-28 7:49 ` Potharla, Rupesh
2022-02-06 13:39 ` Andrew Burgess
1 sibling, 1 reply; 15+ messages in thread
From: Potharla, Rupesh @ 2022-01-28 7:49 UTC (permalink / raw)
To: Andrew Burgess
Cc: gdb-patches, Achra, Nitika, Kaushik, Sharang, Natarajan, Kavitha,
E, Nagajyothi, Kumar N, Bhuvanendra, George, Jini Susan,
Parasuraman, Hariharan, Sharma, Alok Kumar, Balasubrmanian,
Vignesh
[-- Attachment #1: Type: text/plain, Size: 6827 bytes --]
[AMD Official Use Only]
Hi Andrew,
Request to review the attached patch file and please find comments inline below ...
Regards,
Rupesh P
> -----Original Message-----
> From: Andrew Burgess <aburgess@redhat.com>
> Sent: Saturday, January 22, 2022 12:37 AM
> > 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.
>
The complete support for assumed rank is recently added in gcc. https://gcc.gnu.org/bugzilla/show_bug.cgi?id=103315 . Made changes in the testcase for skipping the testcase run for older compilers.
>
> > 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.
> >
> > 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.
Added commit message describing the main body of the commit message. And also kept lines under ~76ish.
> > 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?
>
I considered accommodating changes using push_initial_value mechanism. The push_initial_value is pushing address to the stack the requirement is to push scalar value onto the stack. So I could not make use of this mechanism.
> > if (push_initial_value)
> > {
> > if (addr_stack != nullptr)
> > 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
> <https://nam11.safelinks.protection.outlook.com/?url=http%3A%2F%2Fww
> w.gnu.org%2Flicenses%2F&data=04%7C01%7Crupesh.potharla%40amd
> .com%7Cc481b41f3aa843656da008d9dd113ffe%7C3dd8961fe4884e608e11a
> 82d994e183d%7C0%7C0%7C637783888447831759%7CUnknown%7CTWFpbG
> Zsb3d8eyJWIjoiMC4wLjAwMDAiLCJQIjoiV2luMzIiLCJBTiI6Ik1haWwiLCJXVCI6
> Mn0%3D%7C3000&sdata=qcvs2DAFdVDL3s7Evqm5v6cr8%2FzI1WZ%2B
> Htvf1Mq39XA%3D&reserved=0> .
> > +
> > +# 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?
>
Added 'additional_flags=-gdwarf-5' for gfortran for versions >=11 in the testcase.
> I'll try to take a detailed look through next week.
>
> Thanks,
> Andrew
[-- Attachment #2: 0001-Support-for-Fortran-s-ASSUMED-RANK.patch --]
[-- Type: application/octet-stream, Size: 22518 bytes --]
From ca6a7e6fd09033ba4401eddd2991d025882e78b0 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 reads assumed rank array rank value using rank attribute and
stores the dimensions in a dynamic property list of main_type. Creates
types based on the rank value stores and link them to the main_type.
The patch pushes array descriptor onto the stack and evaluates the generic
subrange tag to get array dimensions.
The purpose of the patch is to print rank, type and values of assumed rank arrays.
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
---
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 | 85 +++++++++++++++++++++++
gdb/testsuite/gdb.fortran/assumedrank.f90 | 42 +++++++++++
10 files changed, 215 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);
+
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..9337ccc4378
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/assumedrank.exp
@@ -0,0 +1,85 @@
+# 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
+
+#only gcc version >=11 supports assumed rank
+if {![test_compiler_info {gcc-1[1-9]-*}]} {
+ untested "compiler do not support assumed rank"
+ return -1
+}
+
+if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
+ {debug f90 additional_flags=-gdwarf-5}]} {
+ 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
^ permalink raw reply [flat|nested] 15+ messages in thread
* Re: [PATCH] Support for Fortran's ASSUMED RANK
2022-01-28 7:49 ` Potharla, Rupesh
@ 2022-02-06 13:39 ` Andrew Burgess
2022-03-16 11:54 ` Potharla, Rupesh
0 siblings, 1 reply; 15+ messages in thread
From: Andrew Burgess @ 2022-02-06 13:39 UTC (permalink / raw)
To: Potharla, Rupesh
Cc: Achra, Nitika, Kaushik, Sharang, Natarajan, Kavitha, George,
Jini Susan, Kumar N, Bhuvanendra, E, Nagajyothi, Parasuraman,
Hariharan, Sharma, Alok Kumar, Balasubrmanian, Vignesh,
gdb-patches
* Potharla, Rupesh via Gdb-patches <gdb-patches@sourceware.org> [2022-01-28 07:49:54 +0000]:
> [AMD Official Use Only]
>
> Hi Andrew,
>
> Request to review the attached patch file and please find comments inline below ...
>
>
> Regards,
> Rupesh P
>
> > -----Original Message-----
> > From: Andrew Burgess <aburgess@redhat.com>
> > Sent: Saturday, January 22, 2022 12:37 AM
> > > 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.
> >
>
> The complete support for assumed rank is recently added in gcc. https://gcc.gnu.org/bugzilla/show_bug.cgi?id=103315 . Made changes in the testcase for skipping the testcase run for older compilers.
>
> >
> > > 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.
> > >
> > > 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.
>
> Added commit message describing the main body of the commit message. And also kept lines under ~76ish.
>
> > > 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?
> >
> I considered accommodating changes using push_initial_value
> mechanism. The push_initial_value is pushing address to the stack
> the requirement is to push scalar value onto the stack. So I could
> not make use of this mechanism.
I still think we should investigate a solution that makes use of the
existing push initial value mechanism, even if we end up needing to
improve that first.
It feels (to me) that just adding more random arguments for things we
want to push is going to make for a clunky API.
Just my thoughts, maybe other maintainers will disagree.
I'll take a look at this and see if I can come up with something, but,
I don't know how much time I'll have to work on this over the next
week.
Thanks,
Andrew
^ permalink raw reply [flat|nested] 15+ messages in thread
* RE: [PATCH] Support for Fortran's ASSUMED RANK
2022-02-06 13:39 ` Andrew Burgess
@ 2022-03-16 11:54 ` Potharla, Rupesh
2022-03-23 11:58 ` Andrew Burgess
0 siblings, 1 reply; 15+ messages in thread
From: Potharla, Rupesh @ 2022-03-16 11:54 UTC (permalink / raw)
To: Andrew Burgess
Cc: gdb-patches, George, Jini Susan, Parasuraman, Hariharan, Sharma,
Alok Kumar
[-- Attachment #1: Type: text/plain, Size: 7294 bytes --]
[AMD Official Use Only]
Hi Andrew,
> I still think we should investigate a solution that makes use of the existing
> push initial value mechanism, even if we end up needing to improve that
> first.
>
> It feels (to me) that just adding more random arguments for things we want
> to push is going to make for a clunky API.
I had made code changes making use of push initial value mechanism. Request to review the attached patch file and let me know your suggestions?
Regards,
Rupesh P
> -----Original Message-----
> From: Andrew Burgess <aburgess@redhat.com>
> Sent: Sunday, February 6, 2022 7:10 PM
> To: Potharla, Rupesh <Rupesh.Potharla@amd.com>
> Cc: Achra, Nitika <Nitika.Achra@amd.com>; Kaushik, Sharang
> <Sharang.Kaushik@amd.com>; Natarajan, Kavitha
> <Kavitha.Natarajan@amd.com>; George, Jini Susan
> <JiniSusan.George@amd.com>; Kumar N, Bhuvanendra
> <Bhuvanendra.KumarN@amd.com>; E, Nagajyothi
> <Nagajyothi.E@amd.com>; Parasuraman, Hariharan
> <Hariharan.Parasuraman@amd.com>; Sharma, Alok Kumar
> <AlokKumar.Sharma@amd.com>; Balasubrmanian, Vignesh
> <Vignesh.Balasubrmanian@amd.com>; gdb-patches@sourceware.org
> Subject: Re: [PATCH] Support for Fortran's ASSUMED RANK
>
> [CAUTION: External Email]
>
> * Potharla, Rupesh via Gdb-patches <gdb-patches@sourceware.org> [2022-
> 01-28 07:49:54 +0000]:
>
> > [AMD Official Use Only]
> >
> > Hi Andrew,
> >
> > Request to review the attached patch file and please find comments inline
> below ...
> >
> >
> > Regards,
> > Rupesh P
> >
> > > -----Original Message-----
> > > From: Andrew Burgess <aburgess@redhat.com>
> > > Sent: Saturday, January 22, 2022 12:37 AM
> > > > 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.
> > >
> >
> > The complete support for assumed rank is recently added in gcc.
> https://nam11.safelinks.protection.outlook.com/?url=https%3A%2F%2Fgcc.g
> nu.org%2Fbugzilla%2Fshow_bug.cgi%3Fid%3D103315&data=04%7C01%
> 7Crupesh.potharla%40amd.com%7C96b732e5f3144fce251008d9e9762835%7
> C3dd8961fe4884e608e11a82d994e183d%7C0%7C0%7C637797515982891186
> %7CUnknown%7CTWFpbGZsb3d8eyJWIjoiMC4wLjAwMDAiLCJQIjoiV2luMzIiL
> CJBTiI6Ik1haWwiLCJXVCI6Mn0%3D%7C3000&sdata=l10%2Bju6B%2BghE
> sLYgT6FDQVQJ6EAr6crdoHl%2FiFrGim8%3D&reserved=0 . Made
> changes in the testcase for skipping the testcase run for older compilers.
> >
> > >
> > > > 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.
> > > >
> > > > 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.
> >
> > Added commit message describing the main body of the commit message.
> And also kept lines under ~76ish.
> >
> > > > 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?
> > >
> > I considered accommodating changes using push_initial_value
> > mechanism. The push_initial_value is pushing address to the stack the
> > requirement is to push scalar value onto the stack. So I could not
> > make use of this mechanism.
>
> I still think we should investigate a solution that makes use of the existing
> push initial value mechanism, even if we end up needing to improve that
> first.
>
> It feels (to me) that just adding more random arguments for things we want
> to push is going to make for a clunky API.
>
> Just my thoughts, maybe other maintainers will disagree.
>
> I'll take a look at this and see if I can come up with something, but, I don't
> know how much time I'll have to work on this over the next week.
>
> Thanks,
> Andrew
[-- Attachment #2: 0001-Support-for-Fortran-s-ASSUMED-RANK.patch --]
[-- Type: application/octet-stream, Size: 16506 bytes --]
From ec5a5a05e82d8399c83add5a5ea42ff905031c41 Mon Sep 17 00:00:00 2001
From: rupothar <rupesh.potharla@amd.com>
Date: Wed, 16 Mar 2022 16:21:53 +0530
Subject: [PATCH] Support for Fortran's ASSUMED RANK.
This patch reads assumed rank array rank value using rank attribute and
stores the dimensions in a dynamic property list of main_type. Creates
types based on the rank value stores and link them to the main_type.
The patch pushes array descriptor onto the stack and evaluates the generic
subrange tag to get array dimensions.
The purpose of the patch is to print rank, type and values of assumed rank arrays.
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/dwarf2/loc.c | 4 ++
gdb/dwarf2/read.c | 19 ++++-
gdb/f-typeprint.c | 4 +-
gdb/gdbtypes.c | 63 +++++++++++++++--
gdb/gdbtypes.h | 7 ++
gdb/testsuite/gdb.fortran/assumedrank.exp | 86 +++++++++++++++++++++++
gdb/testsuite/gdb.fortran/assumedrank.f90 | 41 +++++++++++
7 files changed, 215 insertions(+), 9 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 badc7f89078..be47c41ddcb 100644
--- a/gdb/dwarf2/loc.c
+++ b/gdb/dwarf2/loc.c
@@ -1562,7 +1562,11 @@ dwarf2_locexpr_baton_eval (const struct dwarf2_locexpr_baton *dlbaton,
if (push_initial_value)
{
if (addr_stack != nullptr)
+ {
ctx.push_address (addr_stack->addr, false);
+ if (addr_stack->type->code() == TYPE_CODE_RANGE)
+ addr_stack = addr_stack->next;
+ }
else
ctx.push_address (0, false);
}
diff --git a/gdb/dwarf2/read.c b/gdb/dwarf2/read.c
index 10550336063..96ab399546b 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;
@@ -9722,6 +9724,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. */
@@ -16652,7 +16655,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);
@@ -18974,6 +18978,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;
@@ -19107,6 +19112,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)
@@ -22037,6 +22043,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:
sym->set_aclass_index (LOC_TYPEDEF);
sym->set_domain (VAR_DOMAIN);
list_to_add = cu->list_in_scope;
@@ -22530,6 +22537,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;
@@ -24813,6 +24821,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 3b26bf74b61..183686adc2c 100644
--- a/gdb/f-typeprint.c
+++ b/gdb/f-typeprint.c
@@ -178,9 +178,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/gdbtypes.c b/gdb/gdbtypes.c
index f41d6bd960e..db106913f8e 100644
--- a/gdb/gdbtypes.c
+++ b/gdb/gdbtypes.c
@@ -2199,7 +2199,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,
- bool resolve_p = true)
+ bool resolve_p = true, bool push_initial_value = false)
{
CORE_ADDR value;
struct type *static_range_type, *static_target_type;
@@ -2208,13 +2208,15 @@ 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,
+ push_initial_value))
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,
+ push_initial_value))
{
high_bound.set_const_val (value);
@@ -2227,7 +2229,8 @@ 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,
+ push_initial_value))
{
stride.set_const_val (value);
@@ -2275,8 +2278,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;
+ int i;
+ static int rank = 0;
/* For dynamic type resolution strings can be treated like arrays of
characters. */
@@ -2312,8 +2319,54 @@ resolve_dynamic_array_or_string (struct type *type,
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))
+ {
+ 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);
+
+ if (!rank)
+ range_type = resolve_dynamic_range (range_type, addr_stack, resolve_p);
+ else
+ {
+ /* push array dimension onto the stack before evaluating
+ expression to get array bounds. */
+ struct property_addr_info pinfo;
+ pinfo.type = range_type;
+ pinfo.next = addr_stack;
+ pinfo.addr = (CORE_ADDR)(rank-1);
+ range_type = resolve_dynamic_range (range_type, &pinfo, resolve_p,
+ /*push_initial_value*/ true);
+ }
+
+ if (rank)
+ rank--;
ary_dim = check_typedef (TYPE_TARGET_TYPE (type));
if (ary_dim != NULL && ary_dim->code () == TYPE_CODE_ARRAY)
diff --git a/gdb/gdbtypes.h b/gdb/gdbtypes.h
index bd192da4b4b..2dab6c26651 100644
--- a/gdb/gdbtypes.h
+++ b/gdb/gdbtypes.h
@@ -570,6 +570,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,
};
@@ -2049,6 +2053,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
@@ -2091,6 +2096,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/testsuite/gdb.fortran/assumedrank.exp b/gdb/testsuite/gdb.fortran/assumedrank.exp
new file mode 100644
index 00000000000..8601df82903
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/assumedrank.exp
@@ -0,0 +1,86 @@
+# 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
+
+#only gcc version >=11 supports assumed rank
+if { [test_compiler_info gcc*] &&
+ ![test_compiler_info {gcc-1[1-9]-*}]} {
+ untested "compiler do not support assumed rank"
+ return -1
+}
+
+if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
+ {debug f90 additional_flags=-gdwarf-5}]} {
+ 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..95584a35497
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/assumedrank.f90
@@ -0,0 +1,41 @@
+! 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
^ permalink raw reply [flat|nested] 15+ messages in thread
* Re: [PATCH] Support for Fortran's ASSUMED RANK
2022-03-16 11:54 ` Potharla, Rupesh
@ 2022-03-23 11:58 ` Andrew Burgess
2022-03-23 11:59 ` [PATCH 0/3] Fortran assumed rank array support Andrew Burgess
0 siblings, 1 reply; 15+ messages in thread
From: Andrew Burgess @ 2022-03-23 11:58 UTC (permalink / raw)
To: Potharla, Rupesh
Cc: George, Jini Susan, Parasuraman, Hariharan, Sharma, Alok Kumar,
gdb-patches
* Potharla, Rupesh via Gdb-patches <gdb-patches@sourceware.org> [2022-03-16 11:54:18 +0000]:
> [AMD Official Use Only]
>
> Hi Andrew,
>
> > I still think we should investigate a solution that makes use of the existing
> > push initial value mechanism, even if we end up needing to improve that
> > first.
> >
> > It feels (to me) that just adding more random arguments for things we want
> > to push is going to make for a clunky API.
>
> I had made code changes making use of push initial value mechanism. Request to review the attached patch file and let me know your suggestions?
>
Hi Rupesh,
Thanks for continuing to work on this feature. I'm about to post an
alternative series that incorporates your work, but takes a slightly
different approach as to how to pass values to the dwarf expression
evaluator. I'd be grateful if you could take a look at these patches,
and give your opinion.
Of particular interest, there are two places in the patch below where
I didn't understand your change, and in the end I just removed these
from my series. The test case still passes, which tells me these
changes were not required for _this_ test case, but maybe these
changes are needed for some other test cases you've seen? If this is
the case, maybe you could follow up with some extended test cases that
reveal why these two changes are needed?
Anyway, in the patch below I've mentioned the two changes I'm talking
about, so you know what to look for when reviewing my alternative
patches
> From ec5a5a05e82d8399c83add5a5ea42ff905031c41 Mon Sep 17 00:00:00 2001
> From: rupothar <rupesh.potharla@amd.com>
> Date: Wed, 16 Mar 2022 16:21:53 +0530
> Subject: [PATCH] Support for Fortran's ASSUMED RANK.
>
> This patch reads assumed rank array rank value using rank attribute and
> stores the dimensions in a dynamic property list of main_type. Creates
> types based on the rank value stores and link them to the main_type.
>
> The patch pushes array descriptor onto the stack and evaluates the generic
> subrange tag to get array dimensions.
>
> The purpose of the patch is to print rank, type and values of assumed rank arrays.
>
> 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/dwarf2/loc.c | 4 ++
> gdb/dwarf2/read.c | 19 ++++-
> gdb/f-typeprint.c | 4 +-
> gdb/gdbtypes.c | 63 +++++++++++++++--
> gdb/gdbtypes.h | 7 ++
> gdb/testsuite/gdb.fortran/assumedrank.exp | 86 +++++++++++++++++++++++
> gdb/testsuite/gdb.fortran/assumedrank.f90 | 41 +++++++++++
> 7 files changed, 215 insertions(+), 9 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 badc7f89078..be47c41ddcb 100644
> --- a/gdb/dwarf2/loc.c
> +++ b/gdb/dwarf2/loc.c
> @@ -1562,7 +1562,11 @@ dwarf2_locexpr_baton_eval (const struct dwarf2_locexpr_baton *dlbaton,
> if (push_initial_value)
> {
> if (addr_stack != nullptr)
> + {
> ctx.push_address (addr_stack->addr, false);
> + if (addr_stack->type->code() == TYPE_CODE_RANGE)
> + addr_stack = addr_stack->next;
> + }
> else
> ctx.push_address (0, false);
> }
> diff --git a/gdb/dwarf2/read.c b/gdb/dwarf2/read.c
> index 10550336063..96ab399546b 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;
> @@ -9722,6 +9724,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. */
> @@ -16652,7 +16655,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);
>
> @@ -18974,6 +18978,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;
> @@ -19107,6 +19112,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)
> @@ -22037,6 +22043,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:
> sym->set_aclass_index (LOC_TYPEDEF);
> sym->set_domain (VAR_DOMAIN);
> list_to_add = cu->list_in_scope;
> @@ -22530,6 +22537,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;
> @@ -24813,6 +24821,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 3b26bf74b61..183686adc2c 100644
> --- a/gdb/f-typeprint.c
> +++ b/gdb/f-typeprint.c
> @@ -178,9 +178,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 ()))
You remove the data location handling here, and its not clear why.
This was certainly causing some test failures in gdb.fortran/*.exp
tests (or maybe gdb.ada/*.exp?), I don't recall exactly which tests
though.
I reverted this hunk in my patch, but maybe there's a reason why you
made this change?
> {
> /* 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/gdbtypes.c b/gdb/gdbtypes.c
> index f41d6bd960e..db106913f8e 100644
> --- a/gdb/gdbtypes.c
> +++ b/gdb/gdbtypes.c
> @@ -2199,7 +2199,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,
> - bool resolve_p = true)
> + bool resolve_p = true, bool push_initial_value = false)
> {
> CORE_ADDR value;
> struct type *static_range_type, *static_target_type;
> @@ -2208,13 +2208,15 @@ 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,
> + push_initial_value))
> 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,
> + push_initial_value))
> {
> high_bound.set_const_val (value);
>
> @@ -2227,7 +2229,8 @@ 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,
> + push_initial_value))
> {
> stride.set_const_val (value);
>
> @@ -2275,8 +2278,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;
> + int i;
> + static int rank = 0;
I removed this use of a static variable by spliting the containing
function into two parts, an outer core, and an inner worker. Though
gdb itself is single threaded we don't encourage writing thread unsafe
code like this.
>
> /* For dynamic type resolution strings can be treated like arrays of
> characters. */
> @@ -2312,8 +2319,54 @@ resolve_dynamic_array_or_string (struct type *type,
> 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))
> + {
> + 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;
It wasn't clear to me when this case was expected to trigger, other
than if something goes wrong resolving the rank. I ended up replacing
this code with something like:
if (value <= 0)
error (....);
Notice the change from '==' to '<=' as the latter seemed like a better
check, and I now just throw an error. Do you have a test that
triggers this block? And is your original code critical?
Thanks,
Andrew
> + }
> + 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);
> +
> + if (!rank)
> + range_type = resolve_dynamic_range (range_type, addr_stack, resolve_p);
> + else
> + {
> + /* push array dimension onto the stack before evaluating
> + expression to get array bounds. */
> + struct property_addr_info pinfo;
> + pinfo.type = range_type;
> + pinfo.next = addr_stack;
> + pinfo.addr = (CORE_ADDR)(rank-1);
> + range_type = resolve_dynamic_range (range_type, &pinfo, resolve_p,
> + /*push_initial_value*/ true);
> + }
> +
> + if (rank)
> + rank--;
>
> ary_dim = check_typedef (TYPE_TARGET_TYPE (type));
> if (ary_dim != NULL && ary_dim->code () == TYPE_CODE_ARRAY)
> diff --git a/gdb/gdbtypes.h b/gdb/gdbtypes.h
> index bd192da4b4b..2dab6c26651 100644
> --- a/gdb/gdbtypes.h
> +++ b/gdb/gdbtypes.h
> @@ -570,6 +570,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,
> };
> @@ -2049,6 +2053,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
> @@ -2091,6 +2096,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/testsuite/gdb.fortran/assumedrank.exp b/gdb/testsuite/gdb.fortran/assumedrank.exp
> new file mode 100644
> index 00000000000..8601df82903
> --- /dev/null
> +++ b/gdb/testsuite/gdb.fortran/assumedrank.exp
> @@ -0,0 +1,86 @@
> +# 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
> +
> +#only gcc version >=11 supports assumed rank
> +if { [test_compiler_info gcc*] &&
> + ![test_compiler_info {gcc-1[1-9]-*}]} {
> + untested "compiler do not support assumed rank"
> + return -1
> +}
> +
> +if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
> + {debug f90 additional_flags=-gdwarf-5}]} {
> + 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..95584a35497
> --- /dev/null
> +++ b/gdb/testsuite/gdb.fortran/assumedrank.f90
> @@ -0,0 +1,41 @@
> +! 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
>
>
^ permalink raw reply [flat|nested] 15+ messages in thread
* [PATCH 0/3] Fortran assumed rank array support
2022-03-23 11:58 ` Andrew Burgess
@ 2022-03-23 11:59 ` Andrew Burgess
2022-03-23 11:59 ` [PATCH 1/3] gdb: small simplification in dwarf2_locexpr_baton_eval Andrew Burgess
` (2 more replies)
0 siblings, 3 replies; 15+ messages in thread
From: Andrew Burgess @ 2022-03-23 11:59 UTC (permalink / raw)
To: gdb-patches; +Cc: Andrew Burgess
Feedback welcome,
Thanks,
Andrew
---
Andrew Burgess (2):
gdb: small simplification in dwarf2_locexpr_baton_eval
gdb/dwarf: pass an array of values to the dwarf evaluator
rupothar (1):
gdb: add support for Fortran's ASSUMED RANK arrays
gdb/dwarf2/loc.c | 26 ++---
gdb/dwarf2/loc.h | 8 +-
gdb/dwarf2/read.c | 19 +++-
gdb/gdbtypes.c | 127 +++++++++++++++++++---
gdb/gdbtypes.h | 7 ++
gdb/gnu-v3-abi.c | 2 +-
gdb/testsuite/gdb.fortran/assumedrank.exp | 86 +++++++++++++++
gdb/testsuite/gdb.fortran/assumedrank.f90 | 41 +++++++
8 files changed, 281 insertions(+), 35 deletions(-)
create mode 100644 gdb/testsuite/gdb.fortran/assumedrank.exp
create mode 100644 gdb/testsuite/gdb.fortran/assumedrank.f90
--
2.25.4
^ permalink raw reply [flat|nested] 15+ messages in thread
* [PATCH 1/3] gdb: small simplification in dwarf2_locexpr_baton_eval
2022-03-23 11:59 ` [PATCH 0/3] Fortran assumed rank array support Andrew Burgess
@ 2022-03-23 11:59 ` Andrew Burgess
2022-04-01 19:11 ` Tom Tromey
2022-03-23 11:59 ` [PATCH 2/3] gdb/dwarf: pass an array of values to the dwarf evaluator Andrew Burgess
2022-03-23 11:59 ` [PATCH 3/3] gdb: add support for Fortran's ASSUMED RANK arrays Andrew Burgess
2 siblings, 1 reply; 15+ messages in thread
From: Andrew Burgess @ 2022-03-23 11:59 UTC (permalink / raw)
To: gdb-patches; +Cc: Andrew Burgess
While examining the dwarf expression evaluator, I noticed that in
dwarf2_locexpr_baton_eval, whenever push_initial_value is true, the
addr_stack will never be nullptr.
This allows for a small cleanup, replacing an if/then/else with an
assertion.
There should be no user visible changes after this commit.
---
gdb/dwarf2/loc.c | 18 +++++++++---------
1 file changed, 9 insertions(+), 9 deletions(-)
diff --git a/gdb/dwarf2/loc.c b/gdb/dwarf2/loc.c
index d7863841a69..4c3d04b3226 100644
--- a/gdb/dwarf2/loc.c
+++ b/gdb/dwarf2/loc.c
@@ -1535,11 +1535,13 @@ dwarf2_evaluate_loc_desc (struct type *type, struct frame_info *frame,
CORE_ADDR. FRAME is the frame in which the expression is
evaluated. ADDR_STACK is a context (location of a variable) and
might be needed to evaluate the location expression.
- PUSH_INITIAL_VALUE is true if the address (either from ADDR_STACK,
- or the default of 0) should be pushed on the DWARF expression
- evaluation stack before evaluating the expression; this is required
- by certain forms of DWARF expression. Returns 1 on success, 0
- otherwise. */
+
+ PUSH_INITIAL_VALUE is true if the first address from ADDR_STACK, should
+ be pushed on the DWARF expression evaluation stack before evaluating the
+ expression; this is required by certain forms of DWARF expression. When
+ PUSH_INITIAL_VALUE is true ADDR_STACK can't be nullptr.
+
+ Returns 1 on success, 0 otherwise. */
static int
dwarf2_locexpr_baton_eval (const struct dwarf2_locexpr_baton *dlbaton,
@@ -1561,10 +1563,8 @@ dwarf2_locexpr_baton_eval (const struct dwarf2_locexpr_baton *dlbaton,
if (push_initial_value)
{
- if (addr_stack != nullptr)
- ctx.push_address (addr_stack->addr, false);
- else
- ctx.push_address (0, false);
+ gdb_assert (addr_stack != nullptr);
+ ctx.push_address (addr_stack->addr, false);
}
try
--
2.25.4
^ permalink raw reply [flat|nested] 15+ messages in thread
* [PATCH 2/3] gdb/dwarf: pass an array of values to the dwarf evaluator
2022-03-23 11:59 ` [PATCH 0/3] Fortran assumed rank array support Andrew Burgess
2022-03-23 11:59 ` [PATCH 1/3] gdb: small simplification in dwarf2_locexpr_baton_eval Andrew Burgess
@ 2022-03-23 11:59 ` Andrew Burgess
2022-04-01 19:16 ` Tom Tromey
2022-03-23 11:59 ` [PATCH 3/3] gdb: add support for Fortran's ASSUMED RANK arrays Andrew Burgess
2 siblings, 1 reply; 15+ messages in thread
From: Andrew Burgess @ 2022-03-23 11:59 UTC (permalink / raw)
To: gdb-patches; +Cc: Andrew Burgess
When we need to evaluate a DWARF expression in order to resolve some
dynamic property of a type we call the dwarf2_evaluate_property
function, which is declared in gdb/dwarf/loc.h and defined in
gdb/dwarf/loc.c.
Currently, this function takes (amongst other things) an argument of
type property_addr_info called addr_stack and a boolean called
push_initial_value. When push_initial_value then the top value of
addr_stack is pushed onto the dwarf expression evaluation stack before
the expression is evaluated.
So far this has worked fine, as the only two cases we needed to handle
are the case the DWARF expression doesn't require the object
address (what the top of addr_stack represents), and the case where
the DWARF expression does require the address.
In the next commit this is going to change. As we add support for
Fortran assumed rank arrays, we need to start resolving the dynamic
properties of arrays. To do this, we need to push the array rank onto
the dwarf expression evaluation stack before the expression is
evaluated.
This commit is a refactoring commit aimed at making it easier to
support Fortran assumed rank arrays. Instead of passing a boolean,
and using this to decide if we should push the object address or not,
we instead pass an array (view) of values that should be pushed to the
dwarf expression evaluation stack.
In the couple of places where we previously passed push_initial_value
as true (mostly this was defaulting to false), we now have to pass the
address from the addr_stack as an item in the array view.
In the next commit, when we want to handle passing the array rank,
this will easily be supported too.
There should be no user visible changes after this commit.
---
gdb/dwarf2/loc.c | 20 ++++++++------------
gdb/dwarf2/loc.h | 8 +++++---
gdb/gdbtypes.c | 2 +-
gdb/gnu-v3-abi.c | 2 +-
4 files changed, 15 insertions(+), 17 deletions(-)
diff --git a/gdb/dwarf2/loc.c b/gdb/dwarf2/loc.c
index 4c3d04b3226..8821f56f10d 100644
--- a/gdb/dwarf2/loc.c
+++ b/gdb/dwarf2/loc.c
@@ -1536,10 +1536,8 @@ dwarf2_evaluate_loc_desc (struct type *type, struct frame_info *frame,
evaluated. ADDR_STACK is a context (location of a variable) and
might be needed to evaluate the location expression.
- PUSH_INITIAL_VALUE is true if the first address from ADDR_STACK, should
- be pushed on the DWARF expression evaluation stack before evaluating the
- expression; this is required by certain forms of DWARF expression. When
- PUSH_INITIAL_VALUE is true ADDR_STACK can't be nullptr.
+ PUSH_VALUES is an array of values to be pushed to the expression stack
+ before evaluation starts.
Returns 1 on success, 0 otherwise. */
@@ -1548,7 +1546,7 @@ dwarf2_locexpr_baton_eval (const struct dwarf2_locexpr_baton *dlbaton,
struct frame_info *frame,
const struct property_addr_info *addr_stack,
CORE_ADDR *valp,
- bool push_initial_value,
+ gdb::array_view<CORE_ADDR> push_values,
bool *is_reference)
{
if (dlbaton == NULL || dlbaton->size == 0)
@@ -1561,11 +1559,9 @@ dwarf2_locexpr_baton_eval (const struct dwarf2_locexpr_baton *dlbaton,
value *result;
scoped_value_mark free_values;
- if (push_initial_value)
- {
- gdb_assert (addr_stack != nullptr);
- ctx.push_address (addr_stack->addr, false);
- }
+ /* Place any initial values onto the expression stack. */
+ for (const auto &val : push_values)
+ ctx.push_address (val, false);
try
{
@@ -1611,7 +1607,7 @@ dwarf2_evaluate_property (const struct dynamic_prop *prop,
struct frame_info *frame,
const struct property_addr_info *addr_stack,
CORE_ADDR *value,
- bool push_initial_value)
+ gdb::array_view<CORE_ADDR> push_values)
{
if (prop == NULL)
return false;
@@ -1629,7 +1625,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_values, &is_reference))
{
if (is_reference)
{
diff --git a/gdb/dwarf2/loc.h b/gdb/dwarf2/loc.h
index cf02f609cb0..6943463b7db 100644
--- a/gdb/dwarf2/loc.h
+++ b/gdb/dwarf2/loc.h
@@ -114,14 +114,16 @@ struct property_addr_info
Returns true if PROP could be converted and the static value is passed
back into VALUE, otherwise returns false.
- If PUSH_INITIAL_VALUE is true, then the top value of ADDR_STACK
- will be pushed before evaluating a location expression. */
+ Any values in PUSH_VALUES will be pushe before evaluating the location
+ expression, PUSH_VALUES[0] will be pushed first, then PUSH_VALUES[1],
+ etc. This means the during evaluation PUSH_VALUES[0] will be at the
+ bottom of the stack. */
bool dwarf2_evaluate_property (const struct dynamic_prop *prop,
struct frame_info *frame,
const struct property_addr_info *addr_stack,
CORE_ADDR *value,
- bool push_initial_value = false);
+ gdb::array_view<CORE_ADDR> push_values = {});
/* A helper for the compiler interface that compiles a single dynamic
property to C code.
diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
index f41d6bd960e..6a6acc80b4b 100644
--- a/gdb/gdbtypes.c
+++ b/gdb/gdbtypes.c
@@ -2601,7 +2601,7 @@ resolve_dynamic_struct (struct type *type,
CORE_ADDR addr;
if (dwarf2_evaluate_property (&prop, nullptr, addr_stack, &addr,
- true))
+ {addr_stack->addr}))
resolved_type->field (i).set_loc_bitpos
(TARGET_CHAR_BIT * (addr - addr_stack->addr));
}
diff --git a/gdb/gnu-v3-abi.c b/gdb/gnu-v3-abi.c
index 0cbb8d0d3a6..142fa46f21c 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))
+ {addr_stack.addr}))
return (int) (result - addr_stack.addr);
}
--
2.25.4
^ permalink raw reply [flat|nested] 15+ messages in thread
* [PATCH 3/3] gdb: add support for Fortran's ASSUMED RANK arrays
2022-03-23 11:59 ` [PATCH 0/3] Fortran assumed rank array support Andrew Burgess
2022-03-23 11:59 ` [PATCH 1/3] gdb: small simplification in dwarf2_locexpr_baton_eval Andrew Burgess
2022-03-23 11:59 ` [PATCH 2/3] gdb/dwarf: pass an array of values to the dwarf evaluator Andrew Burgess
@ 2022-03-23 11:59 ` Andrew Burgess
2022-04-01 19:38 ` Tom Tromey
2 siblings, 1 reply; 15+ messages in thread
From: Andrew Burgess @ 2022-03-23 11:59 UTC (permalink / raw)
To: gdb-patches; +Cc: rupothar, Andrew Burgess
From: rupothar <rupesh.potharla@amd.com>
This patch adds a new dynamic property DYN_PROP_RANK, this property is
read from the DW_AT_rank attribute and stored within the type just
like other dynamic properties.
As arrays with dynamic ranks make use of a single
DW_TAG_generic_subrange to represent all ranks of the array, support
for this tag has been added to dwarf2/read.c.
The final piece of this puzzle is to add support in gdbtypes.c so that
we can resolve an array type with dynamic rank. To do this the
existing resolve_dynamic_array_or_string function is split into two,
there's a new resolve_dynamic_array_or_string_1 core that is
responsible for resolving each rank of the array, while the now outer
resolve_dynamic_array_or_string is responsible for figuring out the
array rank (which might require resolving a dynamic property) and then
calling the inner core.
The resolve_dynamic_range function now takes a rank, which is passed
on to the dwarf expression evaluator. This rank will only be used in
the case where the array itself has dynamic rank, but we now pass the
rank in all cases, this should be harmless if the rank is not needed.
The only small nit is that resolve_dynamic_type_internal actually
handles resolving dynamic ranges itself, which now obviously requires
us to pass a rank value. But what rank value to use? In the end I
just passed '1' through here as a sane default, my thinking is that if
we are in resolve_dynamic_type_internal to resolve a range, then the
range isn't part of an array with dynamic rank, and so the range
should actually be using the rank value at all.
An alternative approach would be to make the rank value a
gdb::optional, however, this ends up adding a bunch of complexity to
the code (e.g. having to conditionally build the array to pass to
dwarf2_evaluate_property, and handling the 'rank - 1' in
resolve_dynamic_array_or_string_1) so I haven't done that, but could,
if people think that would be a better approach.
Finally, support for assumed rank arrays was only fixed very recently
in gcc, so you'll need the latest gcc in order to run the tests for
this.
Here's an example test program:
PROGRAM arank
REAL :: a1(10)
CALL sub1(a1)
CONTAINS
SUBROUTINE sub1(a)
REAL :: a(..)
PRINT *, RANK(a)
END SUBROUTINE sub1
END PROGRAM arank
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) break sub1
Breakpoint 1 at 0x4006ff: file assumedrank.f90, line 10.
(gdb) run
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) print RANK(a)
'a' has unknown type; cast it to its declared type
With patch:
gdb -q assumedrank
Reading symbols from assumedrank...
(gdb) break sub1
Breakpoint 1 at 0x4006ff: file assumedrank.f90, line 10.
(gdb) run
Starting program: /home/rupesh/STAGING-BUILD-2787/bin/assumedrank
Breakpoint 1, arank::sub1 (a=...) at assumedrank.f90:10
10 PRINT *, RANK(a)
(gdb) print RANK(a)
$1 = 1
(gdb) ptype a
type = real(kind=4) (10)
(gdb)
Co-Authored-By: Andrew Burgess <aburgess@redhat.com>
---
gdb/dwarf2/read.c | 19 +++-
gdb/gdbtypes.c | 125 +++++++++++++++++++---
gdb/gdbtypes.h | 7 ++
gdb/testsuite/gdb.fortran/assumedrank.exp | 86 +++++++++++++++
gdb/testsuite/gdb.fortran/assumedrank.f90 | 41 +++++++
5 files changed, 263 insertions(+), 15 deletions(-)
create mode 100644 gdb/testsuite/gdb.fortran/assumedrank.exp
create mode 100644 gdb/testsuite/gdb.fortran/assumedrank.f90
diff --git a/gdb/dwarf2/read.c b/gdb/dwarf2/read.c
index f9c942d91d3..da7cc7544e4 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;
@@ -9722,6 +9724,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. */
@@ -16652,7 +16655,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);
@@ -18974,6 +18978,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;
@@ -19107,6 +19112,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)
@@ -22037,6 +22043,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:
sym->set_aclass_index (LOC_TYPEDEF);
sym->set_domain (VAR_DOMAIN);
list_to_add = cu->list_in_scope;
@@ -22530,6 +22537,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;
@@ -24813,6 +24821,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/gdbtypes.c b/gdb/gdbtypes.c
index 6a6acc80b4b..12b2bdde124 100644
--- a/gdb/gdbtypes.c
+++ b/gdb/gdbtypes.c
@@ -2199,7 +2199,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,
- bool resolve_p = true)
+ int rank, bool resolve_p = true)
{
CORE_ADDR value;
struct type *static_range_type, *static_target_type;
@@ -2208,13 +2208,15 @@ 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,
+ { (CORE_ADDR) 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,
+ { (CORE_ADDR) rank }))
{
high_bound.set_const_val (value);
@@ -2227,7 +2229,8 @@ 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,
+ { (CORE_ADDR) rank }))
{
stride.set_const_val (value);
@@ -2258,18 +2261,29 @@ resolve_dynamic_range (struct type *dyn_range_type,
return static_range_type;
}
-/* Resolves dynamic bound values of an array or string type TYPE to static
- ones. ADDR_STACK is a stack of struct property_addr_info to be used if
- needed during the dynamic resolution.
+/* Helper function for resolve_dynamic_array_or_string. This function
+ resolves the properties for a single array at RANK within a nested array
+ of arrays structure. The RANK value is always greater than 0, and
+ starts at it's maximum value and goes down by 1 for each recursive call
+ to this function. So, for a 3-dimensional array, the first call to this
+ function has RANK == 3, then we call ourselves recursively with RANK ==
+ 2, than again with RANK == 1, and at that point we should return.
+
+ TYPE is updated as the dynamic properties are resolved, and so, should
+ be a copy of the dynamic type, rather than the original dynamic type
+ itself.
+
+ ADDR_STACK is a stack of struct property_addr_info to be used if needed
+ during the dynamic resolution.
When RESOLVE_P is true then the dynamic properties of TYPE are
evaluated, otherwise the dynamic properties of TYPE are not evaluated,
instead we assume the array is not allocated/associated yet. */
static struct type *
-resolve_dynamic_array_or_string (struct type *type,
- struct property_addr_info *addr_stack,
- bool resolve_p = true)
+resolve_dynamic_array_or_string_1 (struct type *type,
+ struct property_addr_info *addr_stack,
+ int rank, bool resolve_p)
{
CORE_ADDR value;
struct type *elt_type;
@@ -2283,7 +2297,9 @@ resolve_dynamic_array_or_string (struct type *type,
gdb_assert (type->code () == TYPE_CODE_ARRAY
|| type->code () == TYPE_CODE_STRING);
- type = copy_type (type);
+ /* The outer resolve_dynamic_array_or_string should ensure we always have
+ a rank of at least 1 when we get here. */
+ gdb_assert (rank > 0);
/* Resolve the allocated and associated properties before doing anything
else. If an array is not allocated or not associated then (at least
@@ -2313,11 +2329,16 @@ resolve_dynamic_array_or_string (struct type *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);
ary_dim = check_typedef (TYPE_TARGET_TYPE (type));
if (ary_dim != NULL && ary_dim->code () == TYPE_CODE_ARRAY)
- elt_type = resolve_dynamic_array_or_string (ary_dim, addr_stack, resolve_p);
+ {
+ ary_dim = copy_type (ary_dim);
+ elt_type = resolve_dynamic_array_or_string_1 (ary_dim, addr_stack,
+ rank - 1, resolve_p);
+ }
else
elt_type = TYPE_TARGET_TYPE (type);
@@ -2345,6 +2366,78 @@ resolve_dynamic_array_or_string (struct type *type,
bit_stride);
}
+/* Resolve an array or string type with dynamic properties, return a new
+ type with the dynamic properties resolved to actual values. The
+ ADDR_STACK represents the location of the object being resolved. */
+
+static struct type *
+resolve_dynamic_array_or_string (struct type *type,
+ struct property_addr_info *addr_stack)
+{
+ CORE_ADDR value;
+ int rank = 0;
+
+ /* For dynamic type resolution strings can be treated like arrays of
+ characters. */
+ gdb_assert (type->code () == TYPE_CODE_ARRAY
+ || type->code () == TYPE_CODE_STRING);
+
+ type = copy_type (type);
+
+ /* Resolve the rank property to get rank value. */
+ struct dynamic_prop *prop = TYPE_RANK_PROP (type);
+ if (dwarf2_evaluate_property (prop, nullptr, addr_stack, &value))
+ {
+ prop->set_const_val (value);
+ rank = value;
+
+ if (rank == 0)
+ {
+ /* The dynamic property list juggling below was from the original
+ patch. I don't understand what this is all about, so I've
+ commented it out for now and added the following error. */
+ error (_("failed to resolve dynamic array rank"));
+ }
+ else if (type->code () == TYPE_CODE_STRING && rank != 1)
+ {
+ /* What would this even mean? A string with a dynamic rank
+ greater than 1. */
+ error (_("unable to handle string with dynamic rank greater than 1"));
+ }
+ else if (rank > 1)
+ {
+ /* Arrays with dynamic rank are initially just an array type
+ with a target type that is the array element.
+
+ However, now we know the rank of the array we need to build
+ the array of arrays structure that GDB expects, that is we
+ need an array type that has a target which is an array type,
+ and so on, until eventually, we have the element type at the
+ end of the chain. Create all the additional array types here
+ by copying the top level array type. */
+ struct type *element_type = TYPE_TARGET_TYPE (type);
+ struct type *rank_type = type;
+ for (int i = 1; i < rank; i++)
+ {
+ TYPE_TARGET_TYPE (rank_type) = copy_type (rank_type);
+ rank_type = TYPE_TARGET_TYPE (rank_type);
+ }
+ TYPE_TARGET_TYPE (rank_type) = element_type;
+ }
+ }
+ else
+ {
+ rank = 1;
+
+ for (struct type *tmp_type = TYPE_TARGET_TYPE (type);
+ check_typedef (tmp_type)->code () == TYPE_CODE_ARRAY;
+ tmp_type = TYPE_TARGET_TYPE (tmp_type))
+ ++rank;
+ }
+
+ return resolve_dynamic_array_or_string_1 (type, addr_stack, rank, true);
+}
+
/* Resolve dynamic bounds of members of the union TYPE to static
bounds. ADDR_STACK is a stack of struct property_addr_info
to be used if needed during the dynamic resolution. */
@@ -2730,7 +2823,11 @@ resolve_dynamic_type_internal (struct type *type,
break;
case TYPE_CODE_RANGE:
- resolved_type = resolve_dynamic_range (type, addr_stack);
+ /* Pass 1 for the rank value here. The assumption is that this
+ rank value is not actually required for the resolution of the
+ dynamic range, otherwise, we'd be resolving this range within
+ the context of a dynamic array. */
+ resolved_type = resolve_dynamic_range (type, addr_stack, 1);
break;
case TYPE_CODE_UNION:
diff --git a/gdb/gdbtypes.h b/gdb/gdbtypes.h
index bd192da4b4b..2dab6c26651 100644
--- a/gdb/gdbtypes.h
+++ b/gdb/gdbtypes.h
@@ -570,6 +570,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,
};
@@ -2049,6 +2053,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
@@ -2091,6 +2096,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/testsuite/gdb.fortran/assumedrank.exp b/gdb/testsuite/gdb.fortran/assumedrank.exp
new file mode 100644
index 00000000000..ac5159cb90c
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/assumedrank.exp
@@ -0,0 +1,86 @@
+# Copyright 2021-2022 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 arrays.
+
+if {[skip_fortran_tests]} { return -1 }
+
+standard_testfile ".f90"
+load_lib fortran.exp
+
+# Only gcc version >=11 supports assumed rank arrays.
+if { [test_compiler_info gcc*] &&
+ ![test_compiler_info {gcc-1[1-9]-*}]} {
+ untested "compiler does not support assumed rank"
+ return -1
+}
+
+if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
+ {debug f90 additional_flags=-gdwarf-5}]} {
+ 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..16f2ee718ca
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/assumedrank.f90
@@ -0,0 +1,41 @@
+! Copyright 2021-2022 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 SUBROUTINE test_rank
+
+END PROGRAM arank
--
2.25.4
^ permalink raw reply [flat|nested] 15+ messages in thread
* Re: [PATCH 1/3] gdb: small simplification in dwarf2_locexpr_baton_eval
2022-03-23 11:59 ` [PATCH 1/3] gdb: small simplification in dwarf2_locexpr_baton_eval Andrew Burgess
@ 2022-04-01 19:11 ` Tom Tromey
0 siblings, 0 replies; 15+ messages in thread
From: Tom Tromey @ 2022-04-01 19:11 UTC (permalink / raw)
To: Andrew Burgess via Gdb-patches; +Cc: Andrew Burgess
>>>>> "Andrew" == Andrew Burgess via Gdb-patches <gdb-patches@sourceware.org> writes:
Andrew> While examining the dwarf expression evaluator, I noticed that in
Andrew> dwarf2_locexpr_baton_eval, whenever push_initial_value is true, the
Andrew> addr_stack will never be nullptr.
Andrew> This allows for a small cleanup, replacing an if/then/else with an
Andrew> assertion.
Seems reasonable.
Tom
^ permalink raw reply [flat|nested] 15+ messages in thread
* Re: [PATCH 2/3] gdb/dwarf: pass an array of values to the dwarf evaluator
2022-03-23 11:59 ` [PATCH 2/3] gdb/dwarf: pass an array of values to the dwarf evaluator Andrew Burgess
@ 2022-04-01 19:16 ` Tom Tromey
0 siblings, 0 replies; 15+ messages in thread
From: Tom Tromey @ 2022-04-01 19:16 UTC (permalink / raw)
To: Andrew Burgess via Gdb-patches; +Cc: Andrew Burgess
>>>>> "Andrew" == Andrew Burgess via Gdb-patches <gdb-patches@sourceware.org> writes:
Andrew> In the couple of places where we previously passed push_initial_value
Andrew> as true (mostly this was defaulting to false), we now have to pass the
Andrew> address from the addr_stack as an item in the array view.
Andrew> In the next commit, when we want to handle passing the array rank,
Andrew> this will easily be supported too.
This looks good, though I have one minor suggestion.
Andrew> - PUSH_INITIAL_VALUE is true if the first address from ADDR_STACK, should
Andrew> - be pushed on the DWARF expression evaluation stack before evaluating the
Andrew> - expression; this is required by certain forms of DWARF expression. When
Andrew> - PUSH_INITIAL_VALUE is true ADDR_STACK can't be nullptr.
Andrew> + PUSH_VALUES is an array of values to be pushed to the expression stack
Andrew> + before evaluation starts.
I think it would be good to indicate which value is pushed first.
Tom
^ permalink raw reply [flat|nested] 15+ messages in thread
* Re: [PATCH 3/3] gdb: add support for Fortran's ASSUMED RANK arrays
2022-03-23 11:59 ` [PATCH 3/3] gdb: add support for Fortran's ASSUMED RANK arrays Andrew Burgess
@ 2022-04-01 19:38 ` Tom Tromey
2022-04-03 16:21 ` Andrew Burgess
0 siblings, 1 reply; 15+ messages in thread
From: Tom Tromey @ 2022-04-01 19:38 UTC (permalink / raw)
To: Andrew Burgess via Gdb-patches; +Cc: Andrew Burgess, rupothar
>>>>> "Andrew" == Andrew Burgess via Gdb-patches <gdb-patches@sourceware.org> writes:
Andrew> An alternative approach would be to make the rank value a
Andrew> gdb::optional, however, this ends up adding a bunch of complexity to
Andrew> the code (e.g. having to conditionally build the array to pass to
Andrew> dwarf2_evaluate_property, and handling the 'rank - 1' in
Andrew> resolve_dynamic_array_or_string_1) so I haven't done that, but could,
Andrew> if people think that would be a better approach.
I don't really have an opinion on this, but didn't want to just
completely ignore it either.
I did notice one oddity.
Andrew> + rank = 1;
Andrew> +
Andrew> + for (struct type *tmp_type = TYPE_TARGET_TYPE (type);
Andrew> + check_typedef (tmp_type)->code () == TYPE_CODE_ARRAY;
Andrew> + tmp_type = TYPE_TARGET_TYPE (tmp_type))
Andrew> + ++rank;
This loop calls check_typedef in the condition, but not when updating
tmp_type. Probably the update clause should also use check_typedef.
I don't know if Fortran even has typedefs, but its safe to do this.
Tom
^ permalink raw reply [flat|nested] 15+ messages in thread
* Re: [PATCH 3/3] gdb: add support for Fortran's ASSUMED RANK arrays
2022-04-01 19:38 ` Tom Tromey
@ 2022-04-03 16:21 ` Andrew Burgess
0 siblings, 0 replies; 15+ messages in thread
From: Andrew Burgess @ 2022-04-03 16:21 UTC (permalink / raw)
To: Tom Tromey, Andrew Burgess via Gdb-patches; +Cc: rupothar
Tom Tromey <tom@tromey.com> writes:
>>>>>> "Andrew" == Andrew Burgess via Gdb-patches <gdb-patches@sourceware.org> writes:
>
> Andrew> An alternative approach would be to make the rank value a
> Andrew> gdb::optional, however, this ends up adding a bunch of complexity to
> Andrew> the code (e.g. having to conditionally build the array to pass to
> Andrew> dwarf2_evaluate_property, and handling the 'rank - 1' in
> Andrew> resolve_dynamic_array_or_string_1) so I haven't done that, but could,
> Andrew> if people think that would be a better approach.
>
> I don't really have an opinion on this, but didn't want to just
> completely ignore it either.
>
> I did notice one oddity.
>
> Andrew> + rank = 1;
> Andrew> +
> Andrew> + for (struct type *tmp_type = TYPE_TARGET_TYPE (type);
> Andrew> + check_typedef (tmp_type)->code () == TYPE_CODE_ARRAY;
> Andrew> + tmp_type = TYPE_TARGET_TYPE (tmp_type))
> Andrew> + ++rank;
>
> This loop calls check_typedef in the condition, but not when updating
> tmp_type. Probably the update clause should also use check_typedef.
> I don't know if Fortran even has typedefs, but its safe to do this.
Thanks for the review. I've pushed this series now with the two
suggestions you made.
If anyone has a strong opinion and would prefer a switch to
gdb::optional, then I'm happy to do that work as a followup patch.
Thanks,
Andrew
^ permalink raw reply [flat|nested] 15+ messages in thread
end of thread, other threads:[~2022-04-03 16:21 UTC | newest]
Thread overview: 15+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-01-19 17:57 [PATCH] Support for Fortran's ASSUMED RANK Potharla, Rupesh
2022-01-21 19:07 ` Andrew Burgess
2022-01-22 7:17 ` Potharla, Rupesh
2022-01-28 7:49 ` Potharla, Rupesh
2022-02-06 13:39 ` Andrew Burgess
2022-03-16 11:54 ` Potharla, Rupesh
2022-03-23 11:58 ` Andrew Burgess
2022-03-23 11:59 ` [PATCH 0/3] Fortran assumed rank array support Andrew Burgess
2022-03-23 11:59 ` [PATCH 1/3] gdb: small simplification in dwarf2_locexpr_baton_eval Andrew Burgess
2022-04-01 19:11 ` Tom Tromey
2022-03-23 11:59 ` [PATCH 2/3] gdb/dwarf: pass an array of values to the dwarf evaluator Andrew Burgess
2022-04-01 19:16 ` Tom Tromey
2022-03-23 11:59 ` [PATCH 3/3] gdb: add support for Fortran's ASSUMED RANK arrays Andrew Burgess
2022-04-01 19:38 ` Tom Tromey
2022-04-03 16:21 ` Andrew Burgess
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).