[PATCH v2 6/7] Fortran: Nested functions, add scope parameter.

[Pawel Wodkowski <pwodkowski@pl.sii.eu>]

From: Bernhard Heckel <bernhard.heckel@intel.com>

In order to avoid name clashing in GDB, we add a scope
to nested subroutines. Enveloping function gives the
scope.
---
 gdb/dwarf2read.c                           | 24 +++++++++++-
 gdb/testsuite/gdb.fortran/nested-funcs.exp | 20 ++++++++--
 gdb/testsuite/gdb.fortran/nested-funcs.f90 | 63 ++++++++++++++++++++++++++++--
 3 files changed, 98 insertions(+), 9 deletions(-)

diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c
index dcf9da8372df..78f96ea0d157 100644
--- a/gdb/dwarf2read.c
+++ b/gdb/dwarf2read.c
@@ -8785,6 +8785,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;
@@ -8794,7 +8795,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;
@@ -10651,8 +10655,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;
+      /* Fall through.  */
+    case DW_TAG_entry_point:
     case DW_TAG_inlined_subroutine:
       read_func_scope (die, cu);
       break;
@@ -22547,6 +22557,16 @@ determine_prefix (struct die_info *die, struct dwarf2_cu *cu)
 	      return name;
 	  }
 	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);
+	  }
+	return determine_prefix (parent, cu);
       case DW_TAG_enumeration_type:
 	parent_type = read_type_die (parent, cu);
 	if (TYPE_DECLARED_CLASS (parent_type))
diff --git a/gdb/testsuite/gdb.fortran/nested-funcs.exp b/gdb/testsuite/gdb.fortran/nested-funcs.exp
index 5e28b0e1a3e2..51c0053d575a 100755
--- a/gdb/testsuite/gdb.fortran/nested-funcs.exp
+++ b/gdb/testsuite/gdb.fortran/nested-funcs.exp
@@ -30,8 +30,8 @@ if ![runto MAIN__] then {
     continue
 }
 # 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.
@@ -47,8 +47,8 @@ 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.
@@ -64,6 +64,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
index 50a63b2c7c30..d4682b25465b 100755
--- a/gdb/testsuite/gdb.fortran/nested-funcs.f90
+++ b/gdb/testsuite/gdb.fortran/nested-funcs.f90
@@ -13,8 +13,62 @@
 ! You should have received a copy of the GNU General Public License
 ! along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
-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 +76,13 @@ program TestNestedFuncs
   END TYPE t_State
 
   TYPE (t_State) :: v_state
-  integer index
+  integer index, local_int
 
   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
 
-- 
2.7.4