From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from us-smtp-delivery-124.mimecast.com (us-smtp-delivery-124.mimecast.com [170.10.129.124]) by sourceware.org (Postfix) with ESMTPS id 002123947C25 for ; Wed, 23 Mar 2022 11:58:14 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 002123947C25 Received: from mail-wm1-f69.google.com (mail-wm1-f69.google.com [209.85.128.69]) by relay.mimecast.com with ESMTP with STARTTLS (version=TLSv1.2, cipher=TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384) id us-mta-641-Uog5BYDYOcyxj2jMNFDD8A-1; Wed, 23 Mar 2022 07:58:12 -0400 X-MC-Unique: Uog5BYDYOcyxj2jMNFDD8A-1 Received: by mail-wm1-f69.google.com with SMTP id i65-20020a1c3b44000000b00385c3f3defaso492227wma.3 for ; Wed, 23 Mar 2022 04:58:12 -0700 (PDT) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=x-gm-message-state:date:from:to:cc:subject:message-id:references :mime-version:content-disposition:in-reply-to; bh=Kx2Rbfi/4H/rdnfqCq5PDOnpzAt0RFEXIbWO3z6vSSk=; b=Sy5FkgWKeFsQrXR39mJ3A3JPZurBLmc1l80qSAMFVaD/Py7GlaCA/0RsgJgFR7kkUE Q8FVH8JaKp2j5FBVydQNZhW7RS/j+mG9zP4QChkgU/ZL8El2PE+yBFCKncwX1vZf7qcc bIa+TSYonG9V+II088yQrvIlDWmsr6dnVctUFDrVxNBIQQrUqcHSeuZOXDQH/cARoS4l kc1bytSNfDeSy+s4XMfXDWXRPSRIjB4WYD4xrWXtz+9PQJFOOI18e78q0WYCfOi5hqp/ KFbW3d5vfJiOb3J5D1KJ5ss+7D4aawA7LjZCjRrrHDDShPnRpiz+z1cnekJ2/6ubfcQ6 cMjQ== X-Gm-Message-State: AOAM531G1f1JJ3I+FQAWm5gz+v84pac8EAnazE041KvbMCHRnZwp6U0g nsT9LFC2Oz8xkZ6fG5o62AJhNKv9TDGwH3AcHqbwTZL7uCLvfRFUSP03rixdXUA7UM0jTR3jUJm S+W+ZcgWdbMEZv5lgFG8k9A== X-Received: by 2002:a05:6000:1688:b0:203:8efe:e0b0 with SMTP id y8-20020a056000168800b002038efee0b0mr26205256wrd.289.1648036691440; Wed, 23 Mar 2022 04:58:11 -0700 (PDT) X-Google-Smtp-Source: ABdhPJyQ5stSZhMAkT6Fru6RYClTnDPRp9lvxMRcxvyoyUHseWiZw5H4mGJLpA5EVo0U/2mM5bKH1g== X-Received: by 2002:a05:6000:1688:b0:203:8efe:e0b0 with SMTP id y8-20020a056000168800b002038efee0b0mr26205229wrd.289.1648036691115; Wed, 23 Mar 2022 04:58:11 -0700 (PDT) Received: from localhost (host109-158-45-15.range109-158.btcentralplus.com. [109.158.45.15]) by smtp.gmail.com with ESMTPSA id p2-20020a5d4582000000b00203f51aa12asm13246216wrq.55.2022.03.23.04.58.10 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Wed, 23 Mar 2022 04:58:10 -0700 (PDT) Date: Wed, 23 Mar 2022 11:58:09 +0000 From: Andrew Burgess To: "Potharla, Rupesh" Cc: "George, Jini Susan" , "Parasuraman, Hariharan" , "Sharma, Alok Kumar" , "gdb-patches@sourceware.org" Subject: Re: [PATCH] Support for Fortran's ASSUMED RANK Message-ID: <20220323115809.GT1212730@redhat.com> References: <20220121190711.GM622389@redhat.com> <20220206133946.GB2706@redhat.com> MIME-Version: 1.0 In-Reply-To: X-Operating-System: Linux/5.8.18-100.fc31.x86_64 (x86_64) X-Uptime: 11:47:21 up 24 days, 1:25, X-Editor: GNU Emacs [ http://www.gnu.org/software/emacs ] X-Mimecast-Spam-Score: 0 X-Mimecast-Originator: redhat.com Content-Type: text/plain; charset=us-ascii Content-Disposition: inline X-Spam-Status: No, score=-12.2 required=5.0 tests=BAYES_00, DKIMWL_WL_HIGH, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, KAM_SHORT, RCVD_IN_DNSWL_NONE, RCVD_IN_MSPIKE_H4, RCVD_IN_MSPIKE_WL, SPF_HELO_NONE, SPF_NONE, TXREP, T_SCC_BODY_TEXT_LINE autolearn=ham autolearn_force=no version=3.4.4 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on server2.sourceware.org X-BeenThere: gdb-patches@sourceware.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gdb-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-List-Received-Date: Wed, 23 Mar 2022 11:58:18 -0000 * Potharla, Rupesh via Gdb-patches [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 > 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= /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 . > + > +# 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 . > + > +! > +! 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 > >