aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--gdb/cp-namespace.c5
-rw-r--r--gdb/doc/gdb.texinfo4
-rw-r--r--gdb/dwarf2read.c63
-rw-r--r--gdb/testsuite/gdb.fortran/nested-funcs-2.exp156
-rw-r--r--gdb/testsuite/gdb.fortran/nested-funcs-2.f9062
-rwxr-xr-xgdb/testsuite/gdb.fortran/nested-funcs.exp21
-rwxr-xr-xgdb/testsuite/gdb.fortran/nested-funcs.f9063
7 files changed, 349 insertions, 25 deletions
diff --git a/gdb/cp-namespace.c b/gdb/cp-namespace.c
index 5b352d1..e15b77e 100644
--- a/gdb/cp-namespace.c
+++ b/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);
diff --git a/gdb/doc/gdb.texinfo b/gdb/doc/gdb.texinfo
index f2713c0..cd1d1c8 100644
--- a/gdb/doc/gdb.texinfo
+++ b/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
diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c
index 1052501..2c11591 100644
--- a/gdb/dwarf2read.c
+++ b/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)
- {
- /* 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. */
+ if (pdi->is_external
+ || cu->language == language_ada
+ || (cu->language == language_fortran
+ && pdi->die_parent
+ && pdi->die_parent->tag == DW_TAG_subprogram))
+ {
+ /* 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))
diff --git a/gdb/testsuite/gdb.fortran/nested-funcs-2.exp b/gdb/testsuite/gdb.fortran/nested-funcs-2.exp
new file mode 100644
index 0000000..e23d8ba
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/nested-funcs-2.exp
@@ -0,0 +1,156 @@
+# 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 that the methods in the container module still require the
+ # module name as context.
+ gdb_test_no_output "set confirm off"
+ gdb_test "break print_from_module" \
+ "Function \\\"print_from_module\\\" not defined."
+
+ # 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 } {
+ # For now this loop is only run with a value of '1'. A later
+ # patch will extend this with the value '0', at which point this
+ # comment will be removed.
+ foreach_with_prefix nest_prefix { 1 } {
+ do_bp_tests ${src_prefix} ${nest_prefix}
+ }
+}
diff --git a/gdb/testsuite/gdb.fortran/nested-funcs-2.f90 b/gdb/testsuite/gdb.fortran/nested-funcs-2.f90
new file mode 100644
index 0000000..c3b4e2b
--- /dev/null
+++ b/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
diff --git a/gdb/testsuite/gdb.fortran/nested-funcs.exp b/gdb/testsuite/gdb.fortran/nested-funcs.exp
index 2cfd402..8d218cb 100755
--- a/gdb/testsuite/gdb.fortran/nested-funcs.exp
+++ b/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"
diff --git a/gdb/testsuite/gdb.fortran/nested-funcs.f90 b/gdb/testsuite/gdb.fortran/nested-funcs.f90
index 3431705..ce2f269 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
generated by cgit v1.1 at 2025-03-08 20:11:19 +0000