From patchwork Mon Aug 7 09:37:34 2017 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: "Wiederhake, Tim" X-Patchwork-Id: 21945 Received: (qmail 87947 invoked by alias); 7 Aug 2017 09:38:21 -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 87576 invoked by uid 89); 7 Aug 2017 09:38:18 -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=Needed X-HELO: mga04.intel.com Received: from mga04.intel.com (HELO mga04.intel.com) (192.55.52.120) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Mon, 07 Aug 2017 09:38:16 +0000 Received: from fmsmga003.fm.intel.com ([10.253.24.29]) by fmsmga104.fm.intel.com with ESMTP/TLS/DHE-RSA-AES256-GCM-SHA384; 07 Aug 2017 02:38:14 -0700 X-ExtLoop1: 1 Received: from irvmail001.ir.intel.com ([163.33.26.43]) by FMSMGA003.fm.intel.com with ESMTP; 07 Aug 2017 02:38:12 -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 v779cCIp028399; Mon, 7 Aug 2017 10:38:12 +0100 Received: from ulvlx001.iul.intel.com (localhost [127.0.0.1]) by ulvlx001.iul.intel.com with ESMTP id v779c5ru025593; Mon, 7 Aug 2017 11:38:05 +0200 Received: (from twiederh@localhost) by ulvlx001.iul.intel.com with LOCAL id v779c5Ad025589; Mon, 7 Aug 2017 11:38:05 +0200 From: Tim Wiederhake To: gdb-patches@sourceware.org Cc: qiyaoltc@gmail.com, Bernhard Heckel Subject: [PATCH v2 6/6] Fortran: Nested functions, add scope parameter. Date: Mon, 7 Aug 2017 11:37:34 +0200 Message-Id: <1502098654-25203-7-git-send-email-tim.wiederhake@intel.com> In-Reply-To: <1502098654-25203-1-git-send-email-tim.wiederhake@intel.com> References: <1502098654-25203-1-git-send-email-tim.wiederhake@intel.com> X-IsSubscribed: yes From: Bernhard Heckel 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: * doc/gdb.texinfo: Describe scope operator. * dwarf2read.c: (partial_die_parent_scope): Add prefix for Fortran subroutines. (process_die): Same. (determine_prefix): Same. gdb/testsuite/ChangeLog: * gdb.fortran/nested-funcs.exp: Add tests for nested subroutines. Adjust existing tests to include prefix. * gdb.fortran/nested-funcs.f90: Add nested subroutines. --- gdb/doc/gdb.texinfo | 3 ++ gdb/dwarf2read.c | 26 +++++++++++- gdb/testsuite/gdb.fortran/nested-funcs.exp | 28 +++++++++++-- gdb/testsuite/gdb.fortran/nested-funcs.f90 | 66 ++++++++++++++++++++++++++++-- 4 files changed, 114 insertions(+), 9 deletions(-) mode change 100755 => 100644 gdb/testsuite/gdb.fortran/nested-funcs.f90 diff --git a/gdb/doc/gdb.texinfo b/gdb/doc/gdb.texinfo index 5f55a67..83ea264 100644 --- a/gdb/doc/gdb.texinfo +++ b/gdb/doc/gdb.texinfo @@ -15259,6 +15259,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 3d6a869..af66c13 100644 --- a/gdb/dwarf2read.c +++ b/gdb/dwarf2read.c @@ -7042,6 +7042,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; @@ -7051,7 +7052,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; @@ -8560,8 +8564,13 @@ 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; + case DW_TAG_entry_point: case DW_TAG_inlined_subroutine: read_func_scope (die, cu); break; @@ -20167,6 +20176,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 index 4c2ee2a..0c8a416 100644 --- a/gdb/testsuite/gdb.fortran/nested-funcs.exp +++ b/gdb/testsuite/gdb.fortran/nested-funcs.exp @@ -31,8 +31,8 @@ if ![runto MAIN__] then { } # Test if we can set a breakpoint in a nested function -gdb_breakpoint "sub_nested_outer" -gdb_continue_to_breakpoint "sub_nested_outer" ".*local_int = 19" +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. @@ -43,13 +43,16 @@ gdb_test "set index = 42" gdb_test "print index" "= 42" "print index at BP_outer, manipulated" gdb_test "print local_int" "= 19" "print local_int in outer function" + # Non-local variable should be affected in one frame up as well. 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 "sub_nested_inner" -gdb_continue_to_breakpoint "sub_nested_inner" ".*local_int = 17" +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. @@ -59,12 +62,29 @@ gdb_test "print index" "= 42" "print index at BP_inner" gdb_test "print v_state%code" "= 61" "print v_state%code at BP_inner" gdb_test "print local_int" "= 17" "print local_int in inner function" + # Test if local variable is still correct. gdb_breakpoint [gdb_get_line_number "! BP_outer_2"] 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