gdb/fortran: Allow for matching symbols with missing scope

This commit allows symbol matching within Fortran code without having
to specify all of the symbol's scope.  For example, given this Fortran
code:

    module aaa
    contains
      subroutine foo
        print *, "hello."
      end subroutine foo
    end module aaa

    subroutine foo
      print *, "hello."
    end subroutine foo

    program test
      call foo
    contains
      subroutine foo
        print *, "hello."
      end subroutine foo

      subroutine bar
        use aaa
        call foo
      end subroutine bar
    end program test

The user can now do this:

    (gdb) b foo
    Breakpoint 1 at 0x4006c2: foo. (3 locations)
    (gdb) info breakpoints
    Num     Type           Disp Enb Address            What
    1       breakpoint     keep y   <MULTIPLE>
    1.1                         y   0x00000000004006c2 in aaa::foo at nest.f90:4
    1.2                         y   0x0000000000400730 in foo at nest.f90:9
    1.3                         y   0x00000000004007c3 in test::foo at nest.f90:16

The user asks for a breakpoint on 'foo' and is given a breakpoint on
all three possible 'foo' locations.  The user is, of course, still
able to specify the scope in order to place a single breakpoint on
just one of the foo functions (or use 'break -qualified foo' to break
on just the global foo).

gdb/ChangeLog:

	* f-lang.c (f_language_defn): Use cp_get_symbol_name_matcher and
	cp_search_name_hash.

gdb/testsuite/ChangeLog:

	* gdb.fortran/nested-funcs-2.exp: Run tests with and without the
	nested function prefix.

gdb/cp-namespace.c

@@ -278,8 +278,9 @@ cp_search_static_and_baseclasses (const char *name,
 
   /* If the scope is a function/method, then look up NESTED as a local
      static variable.  E.g., "print 'function()::static_var'".  */
-  if (TYPE_CODE (scope_type) == TYPE_CODE_FUNC
-      || TYPE_CODE (scope_type) == TYPE_CODE_METHOD)
+  if ((TYPE_CODE (scope_type) == TYPE_CODE_FUNC
+       || TYPE_CODE (scope_type) == TYPE_CODE_METHOD)
+      && domain == VAR_DOMAIN)
     return lookup_symbol (nested, SYMBOL_BLOCK_VALUE (scope_sym.symbol),
 			  VAR_DOMAIN, NULL);
 

gdb/doc/gdb.texinfo

@@ -16554,6 +16554,10 @@ 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
+subroutines (internal subroutines).
 @end table
 
 @node Fortran Defaults

gdb/dwarf2read.c

@@ -8816,6 +8816,7 @@ partial_die_parent_scope (struct partial_die_info *pdi,
       return NULL;
     }
 
+  /* 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;
@@ -8825,7 +8826,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;
@@ -8916,12 +8920,15 @@ 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)
 	      - baseaddr);
-      if (pdi->is_external || cu->language == language_ada)
+      if (pdi->is_external
+	  || cu->language == language_ada
+	  || (cu->language == language_fortran
+	      && pdi->die_parent
+	      && pdi->die_parent->tag == DW_TAG_subprogram))
 	{
-          /* brobecker/2007-12-26: Normally, only "external" DIEs are part
-             of the global scope.  But in Ada, we want to be able to access
-             nested procedures globally.  So all Ada subprograms are stored
-             in the global scope.  */
+          /* Normally, only "external" DIEs are part of the global scope.
+             But in Ada and Fortran, we want to be able to access nested procedures
+             globally.  So all Ada subprograms are stored in the global scope.  */
 	  add_psymbol_to_list (actual_name, strlen (actual_name),
 			       built_actual_name != NULL,
 			       VAR_DOMAIN, LOC_BLOCK,
@@ -9177,7 +9184,7 @@ add_partial_subprogram (struct partial_die_info *pdi,
   if (! pdi->has_children)
     return;
 
-  if (cu->language == language_ada)
+  if (cu->language == language_ada || cu->language == language_fortran)
     {
       pdi = pdi->die_child;
       while (pdi != NULL)
@@ -10613,6 +10620,12 @@ process_die (struct die_info *die, struct dwarf2_cu *cu)
       read_type_unit_scope (die, cu);
       break;
     case DW_TAG_subprogram:
+      /* Nested 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 = true;
+      /* Fall through.  */
     case DW_TAG_inlined_subroutine:
       read_func_scope (die, cu);
       break;
@@ -18640,10 +18653,10 @@ load_partial_dies (const struct die_reader_specs *reader,
 	 inside functions to find template arguments (if the name of the
 	 function does not already contain the template arguments).
 
-	 For Ada, we need to scan the children of subprograms and lexical
-	 blocks as well because Ada allows the definition of nested
-	 entities that could be interesting for the debugger, such as
-	 nested subprograms for instance.  */
+	 For Ada and Fortran, we need to scan the children of subprograms
+	 and lexical blocks as well because these languages allow the
+	 definition of nested entities that could be interesting for the
+	 debugger, such as nested subprograms for instance.  */
       if (last_die->has_children
 	  && (load_all
 	      || last_die->tag == DW_TAG_namespace
@@ -18658,7 +18671,8 @@ load_partial_dies (const struct die_reader_specs *reader,
 		      || last_die->tag == DW_TAG_interface_type
 		      || last_die->tag == DW_TAG_structure_type
 		      || last_die->tag == DW_TAG_union_type))
-	      || (cu->language == language_ada
+	      || ((cu->language == language_ada
+		   || cu->language == language_fortran)
 		  && (last_die->tag == DW_TAG_subprogram
 		      || last_die->tag == DW_TAG_lexical_block))))
 	{
@@ -21619,14 +21633,15 @@ new_symbol (struct die_info *die, struct type *type, struct dwarf2_cu *cu,
 	  SYMBOL_ACLASS_INDEX (sym) = LOC_BLOCK;
 	  attr2 = dwarf2_attr (die, DW_AT_external, cu);
 	  if ((attr2 && (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
-                 stored as a global symbol, because we want to be able to
-                 access them globally.  For instance, we want to be able
-                 to break on a nested subprogram without having to
-                 specify the context.  */
+                 Ada and Fortran subprograms, whether marked external or
+                 not, are always stored as a global symbol, because we want
+                 to be able to access them globally.  For instance, we want
+                 to be able to break on a nested subprogram without having
+                 to specify the context.  */
 	      list_to_add = cu->get_builder ()->get_global_symbols ();
 	    }
 	  else
@@ -22621,6 +22636,16 @@ determine_prefix (struct die_info *die, struct dwarf2_cu *cu)
 	      return name;
 	  }
 	return "";
+      case DW_TAG_subprogram:
+	/* Nested 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))

gdb/f-lang.c

@@ -673,9 +673,9 @@ extern const struct language_defn f_language_defn =
   default_pass_by_reference,
   default_get_string,
   c_watch_location_expression,
-  NULL,				/* la_get_symbol_name_matcher */
+  cp_get_symbol_name_matcher,	/* la_get_symbol_name_matcher */
   iterate_over_symbols,
-  default_search_name_hash,
+  cp_search_name_hash,
   &default_varobj_ops,
   NULL,
   NULL,

gdb/testsuite/gdb.fortran/nested-funcs-2.exp

@@ -0,0 +1,147 @@
+# Copyright 2019 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 <http://www.gnu.org/licenses/> .
+
+# Further testing of placing breakpoints in nested subroutines.
+
+if {[skip_fortran_tests]} { return -1 }
+load_lib "fortran.exp"
+
+standard_testfile ".f90"
+
+if {[prepare_for_testing ${testfile}.exp ${testfile} \
+	 ${srcfile} {debug f90}]} {
+    return -1
+}
+
+set int4 [fortran_int4]
+
+# When WITH_SRC_PREFIX_P is true then some symbol references will be
+# prefixed with the filename.  When WITH_NEST_PREFIX_P is true then
+# nested subroutine symbols will be prefixed with their parent
+# subroutine scope.
+proc do_bp_tests {with_src_prefix_p with_nest_prefix_p} {
+    global testfile srcfile
+    global int4
+    global hex
+
+    clean_restart ${testfile}
+
+    if { $with_src_prefix_p } {
+	set src_prefix "${srcfile}:"
+    } else {
+	set src_prefix ""
+    }
+
+    if { $with_nest_prefix_p } {
+	set nest_prefix "contains_keyword::"
+    } else {
+	set nest_prefix ""
+    }
+
+    # Test setting up breakpoints and otherwise examining nested
+    # functions before the program starts.
+    with_test_prefix "before start" {
+	foreach entry \
+	    [list \
+		 [list "increment" "${int4} \\\(${int4}\\\)"] \
+		 [list "increment_program_global" "${int4} \\\(void\\\)"] \
+		 [list "hidden_variable" "void \\\(void\\\)"]] {
+		     set function [lindex $entry 0]
+		     set type [lindex $entry 1]
+
+		     # Currently referencing symbols using 'info',
+		     # 'whatis' and 'ptype' before the program is
+		     # started doesn't work.  This is the same
+		     # behaviour we see in C++ so I don't think this
+		     # is a failure, just a limitation in current GDB.
+		     if { ${with_nest_prefix_p} } {
+			 gdb_test "info symbol ${nest_prefix}${function}" \
+			     "${function} in section .*"
+			 gdb_test "whatis ${nest_prefix}${function}" "type = ${type}"
+			 gdb_test "ptype ${nest_prefix}${function}" "type = ${type}"
+			 gdb_test "print ${nest_prefix}${function}" "{${type}} $hex <contains_keyword::${function}>"
+		     }
+
+		     gdb_breakpoint "${src_prefix}${nest_prefix}${function}"
+		 }
+    }
+
+    # Break on a contained function and run to it.
+    if {![runto ${src_prefix}[gdb_get_line_number "pre_init"]]} then {
+	perror "couldn't run to breakpoint pre_init"
+	continue
+    }
+
+    # Call a contained function.
+    if { ${with_nest_prefix_p} } {
+	gdb_test "call ${nest_prefix}subroutine_to_call()" " called"
+    }
+
+    # Break on another contained function and run to it.
+    gdb_breakpoint "${src_prefix}${nest_prefix}increment"
+    gdb_continue_to_breakpoint "increment" ".*increment = i \\\+ 1"
+    gdb_breakpoint ${src_prefix}[gdb_get_line_number "post_increment"]
+    gdb_continue_to_breakpoint "post_increment"
+
+    # Check arguments and locals report the correct values. 12 is
+    # passed in and 13 is the result after adding 1.
+    gdb_test "info args" "i = 12"
+    gdb_test "info locals" " = 13"
+
+    # Check we can see variables from an outer program scope.
+    gdb_breakpoint ${src_prefix}[gdb_get_line_number "post_increment_global"]
+    gdb_continue_to_breakpoint "post_increment_global" \
+	".*print \\\*, program_i ! post_increment_global"
+    gdb_test "info args" "No arguments." \
+	"no argument subroutine has no arguments"
+    gdb_test "p program_i" " = 7" "printing outer scoped variable"
+
+    # Stepping into a contained subroutine.
+    gdb_breakpoint ${src_prefix}[gdb_get_line_number "pre_step"]
+    gdb_continue_to_breakpoint "pre_step" ".*call step\\\(\\\) ! pre_step"
+    gdb_test "step" \
+	".*print '\\\(A\\\)', \\\"step\\\" ! post_step" \
+	"step into the correct place"
+
+    # Local hides program global.
+    gdb_breakpoint ${src_prefix}[gdb_get_line_number "post_hidden"]
+    gdb_continue_to_breakpoint "post_hidden" \
+	".*print \\\*, program_i ! post_hidden"
+    gdb_test "p program_i" " = 30" "printing hidden global"
+
+    # Check info symbol, whatis and ptype can find information on
+    # these nested functions.
+    foreach entry \
+	[list \
+	     [list "increment" "${int4} \\\(${int4}\\\)"] \
+	     [list "increment_program_global" "${int4} \\\(void\\\)"]] {
+		 set function [lindex $entry 0]
+		 set type [lindex $entry 1]
+		 with_test_prefix $function {
+		     gdb_test "info symbol ${nest_prefix}$function" \
+			 "$function in section .*"
+		     gdb_test "whatis ${nest_prefix}$function" \
+			 "type = ${type}"
+		     gdb_test "ptype ${nest_prefix}$function" \
+			 "type = ${type}"
+		 }
+	     }
+}
+
+foreach_with_prefix src_prefix { 0 1 } {
+    foreach_with_prefix nest_prefix { 0 1 } {
+	do_bp_tests ${src_prefix} ${nest_prefix}
+    }
+}

gdb/testsuite/gdb.fortran/nested-funcs-2.f90

@@ -0,0 +1,62 @@
+! Copyright 2019 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 <http://www.gnu.org/licenses/> .
+
+module container
+    implicit none
+    integer :: a
+    contains
+    subroutine print_from_module()
+       print *, "hello."
+    end subroutine
+end module
+
+program contains_keyword
+    use container
+    implicit none
+    integer :: program_i, program_j
+    program_j = 12 ! pre_init
+    program_i = 7
+    program_j = increment(program_j) ! pre_increment
+    program_i = increment_program_global() ! pre_increment_program_global
+    call subroutine_to_call()
+    call step() ! pre_step
+    call hidden_variable()
+    call print_from_module()
+    print '(I2)', program_j, program_i ! post_init
+
+contains
+    subroutine subroutine_to_call()
+       print *, "called"
+    end subroutine
+    integer function increment(i)
+       integer :: i
+       increment = i + 1
+       print *, i ! post_increment
+    end function
+    integer function increment_program_global()
+       increment_program_global = program_i + 1
+       ! Need to put in a dummy print here to break on as on some systems the
+       ! variables leave scope at "end function", but on others they do not.
+       print *, program_i ! post_increment_global
+    end function
+    subroutine step()
+       print '(A)', "step" ! post_step
+    end subroutine
+    subroutine hidden_variable()
+       integer :: program_i
+       program_i = 30
+       print *, program_i ! post_hidden
+    end subroutine
+end program contains_keyword

gdb/testsuite/gdb.fortran/nested-funcs.exp

@@ -28,7 +28,10 @@ if {[prepare_for_testing "failed to prepare" $testfile $srcfile {debug f90}]} {
 if ![runto MAIN__] then {
     perror "couldn't run to breakpoint MAIN__"
     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.
@@ -43,6 +46,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 +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"

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