Fortran: Nested functions, add scope parameter.

In order to avoid name clashing in GDB, we add a scope
to nested subroutines. Enveloping function gives the
scope.

Change-Id: I7d424b1e3039613d938aae56ec1a3b3d1cdda744

diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c
index cba551d444e1b24f59be20e90911b18ad293064b..40a1881c5e5ca6097233354aa990fea5ea338735 100644 (file)
--- a/gdb/dwarf2read.c
+++ b/gdb/dwarf2read.c
@@ -6821,6 +6821,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;
@@ -6830,7 +6831,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;
@@ -8330,8 +8334,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;
@@ -19540,6 +19549,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 d098ba197c92c9c6423f74229d4ba8e65e3c6858..9e9ef60aa3f971ee68191f1656ab27e24139f08b 100755 (executable)
--- a/gdb/testsuite/gdb.fortran/nested-funcs.exp
+++ b/gdb/testsuite/gdb.fortran/nested-funcs.exp
@@ -31,8 +31,8 @@ if ![runto MAIN__] then {
 }\r
 \r
 # Test if we can set a breakpoint in a nested function\r
-gdb_breakpoint "sub_nested_outer"\r
-gdb_continue_to_breakpoint "sub_nested_outer" ".*local_int = 19"\r
+gdb_breakpoint "testnestedfuncs::sub_nested_outer"\r
+gdb_continue_to_breakpoint "testnestedfuncs::sub_nested_outer" ".*local_int = 19"\r
 \r
 # Test if we can access local and\r
 # non-local variables defined one level up.\r
@@ -43,13 +43,16 @@ gdb_test "set index = 42"
 gdb_test "print index" "= 42" "print index at BP_outer, manipulated"\r
 gdb_test "print local_int" "= 19" "print local_int in outer function"\r
 \r
+\r
 # Non-local variable should be affected in one frame up as well.\r
 gdb_test "up"\r
 gdb_test "print index" "= 42" "print index at BP1, one frame up"\r
 \r
+\r
 # Test if we can set a breakpoint in a nested function\r
-gdb_breakpoint "sub_nested_inner"\r
-gdb_continue_to_breakpoint "sub_nested_inner" ".*local_int = 17"\r
+gdb_breakpoint "testnestedfuncs::sub_nested_inner"\r
+gdb_continue_to_breakpoint "testnestedfuncs::sub_nested_inner" ".*local_int = 17"\r
+\r
 \r
 # Test if we can access local and\r
 # non-local variables defined two level up.\r
@@ -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"\r
 gdb_test "print local_int" "= 17" "print local_int in inner function"\r
 \r
+\r
 # Test if local variable is still correct.\r
 gdb_breakpoint [gdb_get_line_number "! BP_outer_2"]\r
 gdb_continue_to_breakpoint "! BP_outer_2" ".*! BP_outer_2"\r
 gdb_test "print local_int" "= 19" \\r
   "print local_int in outer function, after sub_nested_inner"\r
 \r
+\r
+# Test if we can set a breakpoint in public routine with the same name as the internal\r
+gdb_breakpoint "sub_nested_outer"\r
+gdb_continue_to_breakpoint "sub_nested_outer" ".*name = 'sub_nested_outer external'"\r
+\r
+\r
+# Test if we can set a breakpoint in public routine with the same name as the internal\r
+gdb_breakpoint "sub_with_sub_nested_outer::sub_nested_outer"\r
+gdb_continue_to_breakpoint "sub_with_sub_nested_outer::sub_nested_outer" ".*local_int = 11"\r
+\r
+\r
+# Test if we can set a breakpoint in public routine with the same name as the internal\r
+gdb_breakpoint "mod1::sub_nested_outer"\r
+gdb_continue_to_breakpoint "mod1::sub_nested_outer" ".*name = 'sub_nested_outer_mod1'"\r
+\r
+\r
 # Sanity check in main.\r
 gdb_breakpoint [gdb_get_line_number "! BP_main"]\r
 gdb_continue_to_breakpoint "! BP_main" ".*! BP_main"\r

diff --git a/gdb/testsuite/gdb.fortran/nested-funcs.f90 b/gdb/testsuite/gdb.fortran/nested-funcs.f90
index 5501b3ba5ce53fbd4bdaf9081167fd6d0cb1b122..23fdd35211e023f64a95d3e4c344c2cab40bfc8c 100755 (executable)
--- 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\r
 ! along with this program.  If not, see <http://www.gnu.org/licenses/>.\r
 \r
-program TestNestedFuncs\r
 \r
+module mod1\r
+  integer :: var_i = 1\r
+  integer :: var_const\r
+  parameter (var_const = 20)\r
+\r
+CONTAINS\r
+\r
+  SUBROUTINE sub_nested_outer\r
+    integer :: local_int\r
+    character (len=20) :: name\r
+\r
+    name = 'sub_nested_outer_mod1'\r
+    local_int = 11\r
+\r
+  END SUBROUTINE sub_nested_outer\r
+end module mod1\r
+\r
+\r
+! Public sub_nested_outer\r
+SUBROUTINE sub_nested_outer\r
+  integer :: local_int\r
+  character (len=16) :: name\r
+\r
+  name = 'sub_nested_outer external'\r
+  local_int = 11\r
+END SUBROUTINE sub_nested_outer\r
+\r
+! Needed indirection to call public sub_nested_outer from main\r
+SUBROUTINE sub_nested_outer_ind\r
+  character (len=20) :: name\r
+\r
+  name = 'sub_nested_outer_ind'\r
+  CALL sub_nested_outer\r
+END SUBROUTINE sub_nested_outer_ind\r
+\r
+! public routine with internal subroutine\r
+SUBROUTINE sub_with_sub_nested_outer()\r
+  integer :: local_int\r
+  character (len=16) :: name\r
+\r
+  name = 'subroutine_with_int_sub'\r
+  local_int = 1\r
+\r
+  CALL sub_nested_outer  ! Should call the internal fct\r
+\r
+CONTAINS\r
+\r
+  SUBROUTINE sub_nested_outer\r
+       integer :: local_int\r
+       local_int = 11\r
+  END SUBROUTINE sub_nested_outer\r
+       \r
+END SUBROUTINE sub_with_sub_nested_outer\r
+\r
+! Main\r
+program TestNestedFuncs\r
+  USE mod1, sub_nested_outer_use_mod1 => sub_nested_outer\r
   IMPLICIT NONE\r
 \r
   TYPE :: t_State\r
@@ -22,10 +78,14 @@ program TestNestedFuncs
   END TYPE t_State\r
 \r
   TYPE (t_State) :: v_state\r
-  integer index\r
+  integer index, local_int\r
 \r
+  local_int = 14\r
   index = 13\r
-  CALL sub_nested_outer\r
+  CALL sub_nested_outer            ! Call internal sub_nested_outer\r
+  CALL sub_nested_outer_ind        ! Call external sub_nested_outer via sub_nested_outer_ind\r
+  CALL sub_with_sub_nested_outer   ! Call external routine with nested sub_nested_outer\r
+  CALL sub_nested_outer_use_mod1   ! Call sub_nested_outer imported via module\r
   index = 11              ! BP_main\r
   v_state%code = 27\r
 \r