From patchwork Fri Sep 8 13:32:51 2017 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: "Wiederhake, Tim" X-Patchwork-Id: 22763 Received: (qmail 23040 invoked by alias); 8 Sep 2017 13:33:34 -0000 Mailing-List: contact gdb-patches-help@sourceware.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Subscribe: List-Archive: List-Post: List-Help: , Sender: gdb-patches-owner@sourceware.org Delivered-To: mailing list gdb-patches@sourceware.org Received: (qmail 22922 invoked by uid 89); 8 Sep 2017 13:33:34 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-25.6 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_0, GIT_PATCH_1, GIT_PATCH_2, GIT_PATCH_3, KAM_LAZY_DOMAIN_SECURITY, RP_MATCHES_RCVD autolearn=ham version=3.3.2 spammy= X-HELO: mga07.intel.com Received: from mga07.intel.com (HELO mga07.intel.com) (134.134.136.100) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Fri, 08 Sep 2017 13:33:31 +0000 Received: from fmsmga004.fm.intel.com ([10.253.24.48]) by orsmga105.jf.intel.com with ESMTP; 08 Sep 2017 06:33:29 -0700 X-ExtLoop1: 1 Received: from irvmail001.ir.intel.com ([163.33.26.43]) by fmsmga004.fm.intel.com with ESMTP; 08 Sep 2017 06:33:27 -0700 Received: from ulvlx001.iul.intel.com (ulvlx001.iul.intel.com [172.28.207.17]) by irvmail001.ir.intel.com (8.14.3/8.13.6/MailSET/Hub) with ESMTP id v88DXRNk024587; Fri, 8 Sep 2017 14:33:27 +0100 Received: from ulvlx001.iul.intel.com (localhost [127.0.0.1]) by ulvlx001.iul.intel.com with ESMTP id v88DXR4e022733; Fri, 8 Sep 2017 15:33:27 +0200 Received: (from twiederh@localhost) by ulvlx001.iul.intel.com with LOCAL id v88DXQQB022729; Fri, 8 Sep 2017 15:33:27 +0200 From: Tim Wiederhake To: gdb-patches@sourceware.org Cc: qiyaoltc@gmail.com, Bernhard Heckel Subject: [PATCH v4 5/5] Fortran: Nested functions, add scope parameter. Date: Fri, 8 Sep 2017 15:32:51 +0200 Message-Id: <1504877571-22441-6-git-send-email-tim.wiederhake@intel.com> In-Reply-To: <1504877571-22441-1-git-send-email-tim.wiederhake@intel.com> References: <1504877571-22441-1-git-send-email-tim.wiederhake@intel.com> X-IsSubscribed: yes From: Bernhard Heckel Like in Ada, we want to be able to set a breakpoint on nested functions, called "contained routines" in Fortran. In order to avoid name clashing in GDB, we add a scope to nested subroutines. Enveloping function gives the scope. xxxx-yy-zz Bernhard Heckel gdb/ChangeLog: * NEWS: Mention nested function support. * dwarf2read.c (add_partial_symbol): Enable for Fortran as well. (new_symbol_full): Same. (add_partial_subprogram): Check for subprogram tag. (partial_die_parent_scope): Add prefix for Fortran subroutines. (process_die): Same. (determine_prefix): Same. gdb/doc/ChangeLog: * doc/gdb.texinfo: Describe scope operator. gdb/testsuite/ChangeLog: * gdb.fortran/nested-funcs.f90: Add nested subroutines. * gdb.fortran/nested-funcs.exp: Add tests for nested subroutines. Adjust existing tests to include prefix. --- gdb/NEWS | 3 ++ gdb/doc/gdb.texinfo | 3 ++ gdb/dwarf2read.c | 36 ++++++++++++++-- gdb/testsuite/gdb.fortran/nested-funcs.exp | 20 +++++++++ gdb/testsuite/gdb.fortran/nested-funcs.f90 | 66 ++++++++++++++++++++++++++++-- 5 files changed, 121 insertions(+), 7 deletions(-) mode change 100755 => 100644 gdb/testsuite/gdb.fortran/nested-funcs.exp mode change 100755 => 100644 gdb/testsuite/gdb.fortran/nested-funcs.f90 diff --git a/gdb/NEWS b/gdb/NEWS index 0156368..ca6d96e 100644 --- a/gdb/NEWS +++ b/gdb/NEWS @@ -3,6 +3,9 @@ *** Changes since GDB 8.0 +* GDB now supports setting breakpoints on nested functions in Fortran using + the scope operator "::". + * GDB now supports DW_TAG_entry_point for Fortran entry-points. * On Unix systems, GDB now supports transmitting environment variables diff --git a/gdb/doc/gdb.texinfo b/gdb/doc/gdb.texinfo index 8282dae..72f53a4 100644 --- a/gdb/doc/gdb.texinfo +++ b/gdb/doc/gdb.texinfo @@ -15285,6 +15285,9 @@ The access component operator. Normally used to access elements in derived types. Also suitable for unions. As unions aren't part of regular Fortran, this can only happen when accessing a register that uses a gdbarch-defined union type. +@item :: +The scope operator. Normally used to access variables in modules or to set +breakpoints on subroutines nested in modules or in other (internal) subroutines. @end table @node Fortran Defaults diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c index 29d5671..b0604b0 100644 --- a/gdb/dwarf2read.c +++ b/gdb/dwarf2read.c @@ -7069,6 +7069,7 @@ partial_die_parent_scope (struct partial_die_info *pdi, return NULL; } + /* Internal (nested) subroutines in Fortran get a prefix. */ if (pdi->tag == DW_TAG_enumerator) /* Enumerators should not get the name of the enumeration as a prefix. */ parent->scope = grandparent_scope; @@ -7078,7 +7079,10 @@ partial_die_parent_scope (struct partial_die_info *pdi, || parent->tag == DW_TAG_class_type || parent->tag == DW_TAG_interface_type || parent->tag == DW_TAG_union_type - || parent->tag == DW_TAG_enumeration_type) + || parent->tag == DW_TAG_enumeration_type + || (cu->language == language_fortran + && parent->tag == DW_TAG_subprogram + && pdi->tag == DW_TAG_subprogram)) { if (grandparent_scope == NULL) parent->scope = parent->name; @@ -7186,7 +7190,9 @@ add_partial_symbol (struct partial_die_info *pdi, struct dwarf2_cu *cu) } case DW_TAG_subprogram: addr = gdbarch_adjust_dwarf2_addr (gdbarch, pdi->lowpc + baseaddr); - if (pdi->is_external || cu->language == language_ada) + if (pdi->is_external + || cu->language == language_ada + || cu->language == language_fortran) { /* brobecker/2007-12-26: Normally, only "external" DIEs are part of the global scope. But in Ada, we want to be able to access @@ -7474,6 +7480,8 @@ add_partial_subprogram (struct partial_die_info *pdi, { if (pdi->tag == DW_TAG_entry_point) add_partial_entry_point (pdi, lowpc, highpc, set_addrmap, cu); + else if (pdi->tag == DW_TAG_subprogram) + add_partial_subprogram (pdi, lowpc, highpc, set_addrmap, cu); pdi = pdi->die_sibling; } } @@ -8642,8 +8650,14 @@ process_die (struct die_info *die, struct dwarf2_cu *cu) case DW_TAG_type_unit: read_type_unit_scope (die, cu); break; - case DW_TAG_entry_point: case DW_TAG_subprogram: + /* Internal subprograms in Fortran get a prefix. */ + if (cu->language == language_fortran + && die->parent != NULL + && die->parent->tag == DW_TAG_subprogram) + cu->processing_has_namespace_info = 1; + /* FALLTHROUGH */ + case DW_TAG_entry_point: case DW_TAG_inlined_subroutine: read_func_scope (die, cu); break; @@ -19263,7 +19277,8 @@ new_symbol_full (struct die_info *die, struct type *type, struct dwarf2_cu *cu, attr2 = dwarf2_attr (die->tag == DW_TAG_entry_point ? die->parent : die, DW_AT_external, cu); if ((attr2 != NULL && (DW_UNSND (attr2) != 0)) - || cu->language == language_ada) + || cu->language == language_ada + || cu->language == language_fortran) { /* Subprograms marked external are stored as a global symbol. Ada subprograms, whether marked external or not, are always @@ -20266,6 +20281,19 @@ determine_prefix (struct die_info *die, struct dwarf2_cu *cu) return TYPE_TAG_NAME (parent_type); return ""; } + case DW_TAG_subprogram: + /* Only internal subroutines in Fortran get a prefix with the name + of the parent's subroutine. */ + if (cu->language == language_fortran) + { + if ((die->tag == DW_TAG_subprogram) + && (dwarf2_name (parent, cu) != NULL)) + return dwarf2_name (parent, cu); + else + return ""; + } + else + return determine_prefix (parent, cu); /* Fall through. */ default: return determine_prefix (parent, cu); diff --git a/gdb/testsuite/gdb.fortran/nested-funcs.exp b/gdb/testsuite/gdb.fortran/nested-funcs.exp old mode 100755 new mode 100644 index f6a5335..ab74736 --- a/gdb/testsuite/gdb.fortran/nested-funcs.exp +++ b/gdb/testsuite/gdb.fortran/nested-funcs.exp @@ -30,6 +30,10 @@ if ![runto MAIN__] then { continue } +# Test if we can set a breakpoint in a nested function +gdb_breakpoint "testnestedfuncs::sub_nested_outer" +gdb_continue_to_breakpoint "testnestedfuncs::sub_nested_outer" ".*local_int = 19" + # Test if we can access local and # non-local variables defined one level up. gdb_breakpoint [gdb_get_line_number "! BP_outer"] @@ -43,6 +47,10 @@ gdb_test "print local_int" "= 19" "print local_int in outer function" gdb_test "up" gdb_test "print index" "= 42" "print index at BP1, one frame up" +# Test if we can set a breakpoint in a nested function +gdb_breakpoint "testnestedfuncs::sub_nested_inner" +gdb_continue_to_breakpoint "testnestedfuncs::sub_nested_inner" ".*local_int = 17" + # Test if we can access local and # non-local variables defined two level up. gdb_breakpoint [gdb_get_line_number "! BP_inner"] @@ -57,6 +65,18 @@ gdb_continue_to_breakpoint "! BP_outer_2" ".*! BP_outer_2" gdb_test "print local_int" "= 19" \ "print local_int in outer function, after sub_nested_inner" +# Test if we can set a breakpoint in public routine with the same name as the internal +gdb_breakpoint "sub_nested_outer" +gdb_continue_to_breakpoint "sub_nested_outer" ".*name = 'sub_nested_outer external'" + +# Test if we can set a breakpoint in public routine with the same name as the internal +gdb_breakpoint "sub_with_sub_nested_outer::sub_nested_outer" +gdb_continue_to_breakpoint "sub_with_sub_nested_outer::sub_nested_outer" ".*local_int = 11" + +# Test if we can set a breakpoint in public routine with the same name as the internal +gdb_breakpoint "mod1::sub_nested_outer" +gdb_continue_to_breakpoint "mod1::sub_nested_outer" ".*name = 'sub_nested_outer_mod1'" + # Sanity check in main. gdb_breakpoint [gdb_get_line_number "! BP_main"] gdb_continue_to_breakpoint "! BP_main" ".*! BP_main" diff --git a/gdb/testsuite/gdb.fortran/nested-funcs.f90 b/gdb/testsuite/gdb.fortran/nested-funcs.f90 old mode 100755 new mode 100644 index 0e99996..e7289de --- a/gdb/testsuite/gdb.fortran/nested-funcs.f90 +++ b/gdb/testsuite/gdb.fortran/nested-funcs.f90 @@ -13,8 +13,64 @@ ! You should have received a copy of the GNU General Public License ! along with this program. If not, see . -program TestNestedFuncs +module mod1 + integer :: var_i = 1 + integer :: var_const + parameter (var_const = 20) + +CONTAINS + + SUBROUTINE sub_nested_outer + integer :: local_int + character (len=20) :: name + + name = 'sub_nested_outer_mod1' + local_int = 11 + + END SUBROUTINE sub_nested_outer +end module mod1 + + +! Public sub_nested_outer +SUBROUTINE sub_nested_outer + integer :: local_int + character (len=16) :: name + + name = 'sub_nested_outer external' + local_int = 11 +END SUBROUTINE sub_nested_outer + +! Needed indirection to call public sub_nested_outer from main +SUBROUTINE sub_nested_outer_ind + character (len=20) :: name + + name = 'sub_nested_outer_ind' + CALL sub_nested_outer +END SUBROUTINE sub_nested_outer_ind + +! public routine with internal subroutine +SUBROUTINE sub_with_sub_nested_outer() + integer :: local_int + character (len=16) :: name + + name = 'subroutine_with_int_sub' + local_int = 1 + + CALL sub_nested_outer ! Should call the internal fct + +CONTAINS + + SUBROUTINE sub_nested_outer + integer :: local_int + local_int = 11 + END SUBROUTINE sub_nested_outer + +END SUBROUTINE sub_with_sub_nested_outer + +! Main +program TestNestedFuncs + USE mod1, sub_nested_outer_use_mod1 => sub_nested_outer IMPLICIT NONE TYPE :: t_State @@ -22,10 +78,14 @@ program TestNestedFuncs END TYPE t_State TYPE (t_State) :: v_state - integer index + integer index, local_int + local_int = 14 index = 13 - CALL sub_nested_outer + CALL sub_nested_outer ! Call internal sub_nested_outer + CALL sub_nested_outer_ind ! Call external sub_nested_outer via sub_nested_outer_ind + CALL sub_with_sub_nested_outer ! Call external routine with nested sub_nested_outer + CALL sub_nested_outer_use_mod1 ! Call sub_nested_outer imported via module index = 11 ! BP_main v_state%code = 27