[PATCH 1/7] DWARF: Don't add nameless modules to partial symbol table.

[Pawel Wodkowski]

From: Bernhard Heckel <***@intel.com>

A name for BLOCK DATA in Fortran is optional. If no
name has been assigned, GDB will crash during read-in of DWARF
when BLOCK DATA is represented via DW_TAG_module.
BLOCK DATA is used for one-time initialization of
non-pointer variables in named common blocks.

2016-06-15 Bernhard Heckel <***@intel.com>

gdb/Changelog:
* dwarf2read.c (add_partial_symbol): Skip nameless modules.

gdb/Testsuite/Changelog:
* gdb.fortran/block-data.f: New.
* gdb.fortran/block-data.exp: New.
---
gdb/dwarf2read.c | 13 ++++---
gdb/testsuite/gdb.fortran/block-data.exp | 51 ++++++++++++++++++++++++++++
gdb/testsuite/gdb.fortran/block-data.f | 58 ++++++++++++++++++++++++++++++++
3 files changed, 117 insertions(+), 5 deletions(-)
create mode 100644 gdb/testsuite/gdb.fortran/block-data.exp
create mode 100644 gdb/testsuite/gdb.fortran/block-data.f

diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c
index d2a8cd44f9a5..89fd4ae15e80 100644
--- a/gdb/dwarf2read.c
+++ b/gdb/dwarf2read.c
@@ -8995,11 +8995,14 @@ add_partial_symbol (struct partial_die_info *pdi, struct dwarf2_cu *cu)
0, cu->language, objfile);
break;
case DW_TAG_module:
- add_psymbol_to_list (actual_name, strlen (actual_name),
- built_actual_name != NULL,
- MODULE_DOMAIN, LOC_TYPEDEF, -1,
- &objfile->global_psymbols,
- 0, cu->language, objfile);
+ /* In Fortran 77 there might be a "BLOCK DATA" module available wihout
+ any name. If so, we skip the module as it doesn't bring any value */
+ if (actual_name != nullptr)
+ add_psymbol_to_list (actual_name, strlen (actual_name),
+ built_actual_name != nullptr,
+ MODULE_DOMAIN, LOC_TYPEDEF, -1,
+ &objfile->global_psymbols,
+ 0, cu->language, objfile);
break;
case DW_TAG_class_type:
case DW_TAG_interface_type:
diff --git a/gdb/testsuite/gdb.fortran/block-data.exp b/gdb/testsuite/gdb.fortran/block-data.exp
new file mode 100644
index 000000000000..2af250ad3886
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/block-data.exp
@@ -0,0 +1,51 @@
+# Copyright 2018 Free Software Foundation, Inc.
+#
+# Contributed by Intel Corp. <***@intel.com>
+#
+# 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/>.
+
+# This test is supposed to test anonymous block-data statement.
+
+if { [skip_fortran_tests] } { return -1 }
+
+standard_testfile .f
+load_lib "fortran.exp"
+
+if {[prepare_for_testing $testfile.exp $testfile $srcfile {debug f90}]} {
+ return -1
+}
+
+if ![runto MAIN__] then {
+ untested "couldn't run to breakpoint MAIN__"
+ return -1
+}
+
+gdb_test "print doub1" "= 1.11\\d+" "print doub1, default values"
+gdb_test "print doub2" "= 2.22\\d+" "print doub2, default values"
+gdb_test "print char1" "= 'abcdef'" "print char1, default values"
+gdb_test "print char2" "= 'ghijkl'" "print char2, default values"
+
+gdb_breakpoint [gdb_get_line_number "! BP_BEFORE_SUB"]
+gdb_continue_to_breakpoint "! BP_BEFORE_SUB" ".*! BP_BEFORE_SUB.*"
+gdb_test "print doub1" "= 11.11\\d+" "print doub1, before sub"
+gdb_test "print doub2" "= 22.22\\d+" "print doub2, before sub"
+gdb_test "print char1" "= 'ABCDEF'" "print char1, before sub"
+gdb_test "print char2" "= 'GHIJKL'" "print char2, before sub"
+
+gdb_breakpoint [gdb_get_line_number "! BP_SUB"]
+gdb_continue_to_breakpoint "! BP_SUB" ".*! BP_SUB.*"
+gdb_test "print doub1" "= 11.11\\d+" "print char1, in sub"
+gdb_test "print doub2" "= 22.22\\d+" "print doub2, in sub"
+gdb_test "print char1" "= 'ABCDEF'" "print char1, in sub"
+gdb_test "print char2" "= 'GHIJKL'" "print char2, in sub"
diff --git a/gdb/testsuite/gdb.fortran/block-data.f b/gdb/testsuite/gdb.fortran/block-data.f
new file mode 100644
index 000000000000..a28e687ec885
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/block-data.f
@@ -0,0 +1,58 @@
+! Copyright 2018 Free Software Foundation, Inc.
+!
+! Contributed by Intel Corp. <***@intel.com>
+!
+! 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/>.
+!
+! Test if GDB can handle block data without global name
+!
+! MAIN
+ PROGRAM bdata
+ DOUBLE PRECISION doub1, doub2
+ CHARACTER*6 char1, char2
+
+ COMMON /BLK1/ doub1, char1
+ COMMON /BLK2/ doub2, char2
+
+ doub1 = 11.111
+ doub2 = 22.222
+ char1 = 'ABCDEF'
+ char2 = 'GHIJKL'
+ CALL sub_block_data ! BP_BEFORE_SUB
+ STOP
+ END
+
+! BLOCK DATA
+ BLOCK DATA
+
+ DOUBLE PRECISION doub1, doub2
+ CHARACTER*6 char1, char2
+
+ COMMON /BLK1/ doub1, char1
+ COMMON /BLK2/ doub2, char2
+ DATA doub1, doub2 /1.111, 2.222/
+ DATA char1, char2 /'abcdef', 'ghijkl'/
+ END
+
+! SUBROUTINE
+ SUBROUTINE sub_block_data
+
+ DOUBLE PRECISION doub1, doub2
+ CHARACTER*6 char1, char2
+
+ COMMON /BLK1/ doub1, char1
+ COMMON /BLK2/ doub2, char2
+
+ char1 = char2; ! BP_SUB
+ END

[Pawel Wodkowski]

From: Bernhard Heckel <***@intel.com>

Fortran provides additional entry-points to an subprogram.
Those entry-points may have only a subset of parameters
of the original subprogram as well.
Add support for parsing DW_TAG_entry_point's for Fortran.

2016-06-01 Bernhard Heckel <***@intel.com>

gdb/Changelog:
* gdb/dwarf2read.c (add_partial_symbol): Handle DW_TAG_entry_point.
(add_partial_entry_point): New.
(add_partial_subprogram): Search for entry_points.
(process_die): Handle DW_TAG_entry_point.
(dwarf2_get_pc_bounds): Update low pc from DWARF.
(load_partial_dies): Save DW_TAG_entry_point's.
(load_partial_dies): Save DW_TAG_entry_point to hash table.
(load_partial_dies): Look into child's of DW_TAG_sub_program
for fortran.
(new_symbol_full): Process DW_TAG_entry_point.
(read_type_die_1): Handle DW_TAG_entry_point.

gdb/Testsuite/Changelog:
* gdb.fortran/entry_point.f90: New.
* gdb.fortran/entry_point.exp: New.
---
gdb/dwarf2read.c | 98 ++++++++++++++++++++++++++++++-
gdb/testsuite/gdb.fortran/entry-point.exp | 70 ++++++++++++++++++++++
gdb/testsuite/gdb.fortran/entry-point.f90 | 48 +++++++++++++++
3 files changed, 215 insertions(+), 1 deletion(-)
create mode 100644 gdb/testsuite/gdb.fortran/entry-point.exp
create mode 100644 gdb/testsuite/gdb.fortran/entry-point.f90

diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c
index 89fd4ae15e80..88e57d7ab68e 100644
--- a/gdb/dwarf2read.c
+++ b/gdb/dwarf2read.c
@@ -1473,6 +1473,10 @@ static void add_partial_module (struct partial_die_info *pdi, CORE_ADDR *lowpc,
static void add_partial_enumeration (struct partial_die_info *enum_pdi,
struct dwarf2_cu *cu);

+static void add_partial_entry_point (struct partial_die_info *pdi,
+ CORE_ADDR *lowpc, CORE_ADDR *highpc,
+ int need_pc, struct dwarf2_cu *cu);
+
static void add_partial_subprogram (struct partial_die_info *pdi,
CORE_ADDR *lowpc, CORE_ADDR *highpc,
int need_pc, struct dwarf2_cu *cu);
@@ -8876,6 +8880,32 @@ add_partial_symbol (struct partial_die_info *pdi, struct dwarf2_cu *cu)

switch (pdi->tag)
{
+ case DW_TAG_entry_point:
+ /* Don't know any other language than fortran which is
+ using DW_TAG_entry_point. */
+ if (cu->language == language_fortran)
+ {
+ addr = gdbarch_adjust_dwarf2_addr (gdbarch, pdi->lowpc + baseaddr);
+ /* DW_TAG_entry_point provides an additional entry_point to an
+ existing sub_program. Therefore, we inherit the "external"
+ attribute from the sub_program to which the entry_point
+ belongs to. */
+ if (pdi->die_parent->is_external)
+ add_psymbol_to_list (actual_name, strlen (actual_name),
+ built_actual_name != nullptr,
+ VAR_DOMAIN, LOC_BLOCK,
+ SECT_OFF_TEXT (objfile),
+ &objfile->global_psymbols,
+ addr, cu->language, objfile);
+ else
+ add_psymbol_to_list (actual_name, strlen (actual_name),
+ built_actual_name != nullptr,
+ VAR_DOMAIN, LOC_BLOCK,
+ SECT_OFF_TEXT (objfile),
+ &objfile->static_psymbols,
+ addr, cu->language, objfile);
+ }
+ break;
case DW_TAG_inlined_subroutine:
case DW_TAG_subprogram:
addr = (gdbarch_adjust_dwarf2_addr (gdbarch, pdi->lowpc + baseaddr)
@@ -9082,6 +9112,17 @@ add_partial_module (struct partial_die_info *pdi, CORE_ADDR *lowpc,
scan_partial_symbols (pdi->die_child, lowpc, highpc, set_addrmap, cu);
}

+static void
+add_partial_entry_point (struct partial_die_info *pdi,
+ CORE_ADDR *p_lowpc, CORE_ADDR *p_highpc,
+ int set_addrmap, struct dwarf2_cu *cu)
+{
+ if (pdi->name == nullptr)
+ complaint (_("DW_TAG_entry_point must have a name"));
+ else
+ add_partial_symbol (pdi, cu);
+}
+
/* Read a partial die corresponding to a subprogram or an inlined
subprogram and create a partial symbol for that subprogram.
When the CU language allows it, this routine also defines a partial
@@ -9158,6 +9199,16 @@ add_partial_subprogram (struct partial_die_info *pdi,
pdi = pdi->die_sibling;
}
}
+ else if (cu->language == language_fortran)
+ {
+ pdi = pdi->die_child;
+ while (pdi != nullptr)
+ {
+ if (pdi->tag == DW_TAG_entry_point)
+ add_partial_entry_point (pdi, lowpc, highpc, set_addrmap, cu);
+ pdi = pdi->die_sibling;
+ }
+ }
}

/* Read a partial die corresponding to an enumeration type. */
@@ -10596,6 +10647,7 @@ 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:
case DW_TAG_inlined_subroutine:
read_func_scope (die, cu);
@@ -14669,6 +14721,26 @@ dwarf2_get_pc_bounds (struct die_info *die, CORE_ADDR *lowpc,
CORE_ADDR high = 0;
enum pc_bounds_kind ret;

+ if (die->tag == DW_TAG_entry_point)
+ {
+ /* Entry_point is embedded in an subprogram. Therefore, we can use
+ the highpc from it's enveloping subprogram and get the
+ lowpc from DWARF. */
+ if (0 == dwarf2_get_pc_bounds (die->parent, lowpc, highpc, cu, pst))
+ return PC_BOUNDS_NOT_PRESENT;
+
+ attr = dwarf2_attr (die, DW_AT_low_pc, cu);
+ if (!attr)
+ {
+ complaint (_("DW_TAG_entry_point is missing DW_AT_low_pc"));
+ return PC_BOUNDS_NOT_PRESENT;
+ }
+ low = attr_value_as_address (attr);
+ *lowpc = low;
+
+ return PC_BOUNDS_HIGH_LOW;
+ }
+
attr_high = dwarf2_attr (die, DW_AT_high_pc, cu);
if (attr_high)
{
@@ -18399,6 +18471,7 @@ load_partial_dies (const struct die_reader_specs *reader,
&& !is_type_tag_for_partial (abbrev->tag)
&& abbrev->tag != DW_TAG_constant
&& abbrev->tag != DW_TAG_enumerator
+ && abbrev->tag != DW_TAG_entry_point
&& abbrev->tag != DW_TAG_subprogram
&& abbrev->tag != DW_TAG_inlined_subroutine
&& abbrev->tag != DW_TAG_lexical_block
@@ -18529,6 +18602,7 @@ load_partial_dies (const struct die_reader_specs *reader,

if (load_all
|| abbrev->tag == DW_TAG_constant
+ || abbrev->tag == DW_TAG_entry_point
|| abbrev->tag == DW_TAG_subprogram
|| abbrev->tag == DW_TAG_variable
|| abbrev->tag == DW_TAG_namespace
@@ -18570,7 +18644,9 @@ load_partial_dies (const struct die_reader_specs *reader,
|| last_die->tag == DW_TAG_union_type))
|| (cu->language == language_ada
&& (last_die->tag == DW_TAG_subprogram
- || last_die->tag == DW_TAG_lexical_block))))
+ || last_die->tag == DW_TAG_lexical_block))
+ || (cu->language == language_fortran
+ && last_die->tag == DW_TAG_subprogram)))
{
nesting_level++;
parent_die = last_die;
@@ -21442,6 +21518,25 @@ new_symbol (struct die_info *die, struct type *type, struct dwarf2_cu *cu,
SYMBOL_ACLASS_INDEX (sym) = LOC_LABEL;
dw2_add_symbol_to_list (sym, cu->list_in_scope);
break;
+ case DW_TAG_entry_point:
+ /* Don't know any other language than fortran which is
+ using DW_TAG_entry_point. */
+ if (cu->language == language_fortran)
+ {
+ /* SYMBOL_BLOCK_VALUE (sym) will be filled in later by
+ finish_block. */
+ SYMBOL_ACLASS_INDEX (sym) = LOC_BLOCK;
+ /* DW_TAG_entry_point provides an additional entry_point to an
+ existing sub_program. Therefore, we inherit the "external"
+ attribute from the sub_program to which the entry_point
+ belongs to. */
+ attr2 = dwarf2_attr (die->parent, DW_AT_external, cu);
+ if (attr2 && (DW_UNSND (attr2) != 0))
+ list_to_add = cu->builder->get_global_symbols ();
+ else
+ list_to_add = cu->list_in_scope;
+ }
+ break;
case DW_TAG_subprogram:
/* SYMBOL_BLOCK_VALUE (sym) will be filled in later by
finish_block. */
@@ -22129,6 +22224,7 @@ read_type_die_1 (struct die_info *die, struct dwarf2_cu *cu)
case DW_TAG_enumeration_type:
this_type = read_enumeration_type (die, cu);
break;
+ case DW_TAG_entry_point:
case DW_TAG_subprogram:
case DW_TAG_subroutine_type:
case DW_TAG_inlined_subroutine:
diff --git a/gdb/testsuite/gdb.fortran/entry-point.exp b/gdb/testsuite/gdb.fortran/entry-point.exp
new file mode 100644
index 000000000000..a1f3f2bebdb9
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/entry-point.exp
@@ -0,0 +1,70 @@
+# Copyright 2018 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/>.
+
+if { [skip_fortran_tests] } { return -1 }
+
+standard_testfile .f90
+load_lib "fortran.exp"
+
+if {[prepare_for_testing $testfile.exp $testfile $srcfile {debug f90}]} {
+ return -1
+}
+
+if ![runto MAIN__] then {
+ perror "couldn't run to breakpoint MAIN__"
+ continue
+}
+
+# Test if we can set a breakpoint via entry-point name
+set ept_name "foo"
+gdb_breakpoint $ept_name
+gdb_test "continue" \
+ [multi_line "Breakpoint $decimal, $ept_name \\(j=1, k=2, l=3, i1=4\\) at .*" \
+ ".*"] \
+ "continue to breakpoint: $ept_name"
+
+gdb_test "print j" "= 1" "print j, entered via $ept_name"
+gdb_test "print k" "= 2" "print k, entered via $ept_name"
+gdb_test "print l" "= 3" "print l, entered via $ept_name"
+gdb_test "print i1" "= 4" "print i1, entered via $ept_name"
+gdb_test "info args" \
+ [multi_line "j = 1" \
+ "k = 2" \
+ "l = 3" \
+ "i1 = 4"] \
+ "info args, entered via $ept_name"
+
+# Test if we can set a breakpoint via function name
+set ept_name "bar"
+gdb_breakpoint $ept_name
+gdb_test "continue" \
+ [multi_line "Breakpoint $decimal, $ept_name \\(i=4, j=5, k=6, i1=7\\) at .*" \
+ ".*"] \
+ "continue to breakpoint: $ept_name"
+
+gdb_test "print i" "= 4" "print i, entered via $ept_name"
+gdb_test "print j" "= 5" "print j, entered via $ept_name"
+gdb_test "print k" "= 6" "print k, entered via $ept_name"
+gdb_test "print i1" "= 7" "print i1, entered via $ept_name"
+
+set ept_name "tim"
+gdb_breakpoint $ept_name
+gdb_test "continue" \
+ [multi_line "Breakpoint $decimal, $ept_name \\(j=1\\) at .*" \
+ ".*"] \
+ "continue to breakpoint: $ept_name"
+
+gdb_test "print j" "= 1" "print j, entered via $ept_name"
+gdb_test "info args" "j = 1" "info args, entered via $ept_name"
diff --git a/gdb/testsuite/gdb.fortran/entry-point.f90 b/gdb/testsuite/gdb.fortran/entry-point.f90
new file mode 100644
index 000000000000..cb663b956982
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/entry-point.f90
@@ -0,0 +1,48 @@
+! Copyright 2018 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/>.
+
+program TestEntryPoint
+
+ call foo(1,2,3,4)
+ call bar(4,5,6,7)
+ call tim(1)
+
+end program TestEntryPoint
+
+ subroutine bar(I,J,K,I1)
+ INTEGER I,J,K,L,I1
+ INTEGER A
+ REAL C
+
+ A = 0
+ C = 0.0
+
+ A = I + K + I1
+ goto 1000
+
+ entry foo(J,K,L,I1)
+ A = J + K + L + I1
+
+200 C = J
+ goto 1000
+
+ entry tim(J)
+ goto 200
+
+1000 A = C + 1
+ C = J * 1.5
+
+ return
+ end subroutine

[Pawel Wodkowski]

From: Bernhard Heckel <***@intel.com>

Fortran 2003 supports type extension. This patch allows access
to inherited members by using it's fully qualified name as
described in the fortran standard.

Before:
(gdb) print my_extended_obj%base_class_name%member_base
Syntax error near base_class_name%member_base

(gdb) print my_extended_obj%member_base
$1 = (10, 10, 10)

After:
(gdb) print my_extended_obj%base_clase_name%member_base
$1 = (10, 10, 10)

(gdb) print my_extended_obj%member_base
$1 = (10, 10, 10)

2016-04-22 Bernhard Heckel <***@intel.com>

gdb/Changelog:
* f-exp.y (name): Allow TYPENAME.
* valops.c (search_struct_method): Look also for baseclass.

gdb/Testsuite/Changelog:
* gdb.fortran/oop-extend-type.f90: New.
* gdb.fortran/oop-extend-type.exp: New.
---
gdb/f-exp.y | 7 +-
gdb/testsuite/gdb.fortran/oop-extend-type.exp | 113 ++++++++++++++++++++++++++
gdb/testsuite/gdb.fortran/oop-extend-type.f90 | 56 +++++++++++++
gdb/valops.c | 6 ++
4 files changed, 180 insertions(+), 2 deletions(-)
create mode 100644 gdb/testsuite/gdb.fortran/oop-extend-type.exp
create mode 100644 gdb/testsuite/gdb.fortran/oop-extend-type.f90

diff --git a/gdb/f-exp.y b/gdb/f-exp.y
index 390bd45081b7..4c2e101699ac 100644
--- a/gdb/f-exp.y
+++ b/gdb/f-exp.y
@@ -604,8 +604,11 @@ nonempty_typelist
}
;

-name : NAME
- { $$ = $1.stoken; }
+name
+ : NAME
+ { $$ = $1.stoken; }
+ | TYPENAME
+ { $$ = $1.stoken; }
;

name_not_typename : NAME
diff --git a/gdb/testsuite/gdb.fortran/oop-extend-type.exp b/gdb/testsuite/gdb.fortran/oop-extend-type.exp
new file mode 100644
index 000000000000..8c3bb50a3ac6
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/oop-extend-type.exp
@@ -0,0 +1,113 @@
+# Copyright 2018 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/>.
+
+standard_testfile ".f90"
+load_lib "fortran.exp"
+
+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
+ {debug f90 quiet}] } {
+ return -1
+}
+
+if ![runto_main] {
+ untested "could not run to main"
+ return -1
+}
+
+# Depending on the compiler being used, the type names can be printed differently.
+set real [fortran_real4]
+
+gdb_breakpoint [gdb_get_line_number "! Before vla allocation"]
+gdb_continue_to_breakpoint "! Before vla allocation" ".*! Before vla allocation"
+gdb_test "whatis wp_vla" "type = <not allocated>"
+
+gdb_breakpoint [gdb_get_line_number "! After value assignment"]
+gdb_continue_to_breakpoint "! After value assignment" ".*! After value assignment"
+set test "p wp%coo"
+gdb_test_multiple "$test" "$test" {
+ -re " = \\(1, 2, 1\\)\r\n$gdb_prompt $" {
+ pass "$test"
+ }
+ -re "There is no member named coo.\r\n$gdb_prompt $" {
+ kfail "gcc/49475" "$test"
+ }
+}
+gdb_test "p wp%point%coo" " = \\(1, 2, 1\\)"
+gdb_test "p wp%point" " = \\( coo = \\(1, 2, 1\\) \\)"
+gdb_test "p wp" " = \\( point = \\( coo = \\(1, 2, 1\\) \\), angle = 100 \\)"
+
+gdb_test "whatis wp" "type = Type waypoint"
+set output_pass [multi_line "type = Type, extends\\(point\\) :: waypoint" \
+ " Type point :: point" \
+ " $real :: angle" \
+ "End Type waypoint"]
+set output_kfail [multi_line "type = Type waypoint" \
+" Type point :: point" \
+" $real :: angle" \
+"End Type waypoint"]
+set test "ptype wp"
+gdb_test_multiple $test %test {
+ -re "$output_pass\r\n$gdb_prompt $" {
+ pass "$test"
+ }
+ -re "$output_kfail\r\n$gdb_prompt $" {
+ kfail "gcc/49475" "$test"
+ }
+}
+
+set test "ptype wp%coo"
+gdb_test_multiple "$test" "$test" {
+ -re "$real \\(3\\)\r\n$gdb_prompt $" {
+ pass "$test"
+ }
+ -re "There is no member named coo.\r\n$gdb_prompt $" {
+ kfail "gcc/49475" "$test"
+ }
+}
+gdb_test "ptype wp%point%coo" "$real \\(3\\)"
+
+set test "p wp_vla(1)%coo"
+gdb_test_multiple "$test" "$test" {
+ -re " = \\(10, 12, 10\\)\r\n$gdb_prompt $" {
+ pass "$test"
+ }
+ -re "There is no member named coo.\r\n$gdb_prompt $" {
+ kfail "gcc/49475" "$test"
+ }
+}
+gdb_test "p wp_vla(1)%point%coo" " = \\(10, 12, 10\\)"
+gdb_test "p wp_vla(1)%point" " = \\( coo = \\(10, 12, 10\\) \\)"
+gdb_test "p wp_vla(1)" " = \\( point = \\( coo = \\(10, 12, 10\\) \\), angle = 101 \\)"
+
+gdb_test "whatis wp_vla" "type = Type waypoint \\(3\\)"
+set test "ptype wp_vla"
+gdb_test_multiple $test %test {
+ -re "$output_pass \\(3\\)\r\n$gdb_prompt $" {
+ pass "$test"
+ }
+ -re "$output_kfail \\(3\\)\r\n$gdb_prompt $" {
+ kfail "gcc/49475" "$test"
+ }
+}
+set test "ptype wp_vla(1)%coo"
+gdb_test_multiple "$test" "$test" {
+ -re "$real \\(3\\)\r\n$gdb_prompt $" {
+ pass "$test"
+ }
+ -re "There is no member named coo.\r\n$gdb_prompt $" {
+ kfail "gcc/49475" "$test"
+ }
+}
+gdb_test "ptype wp_vla(1)%point%coo" "$real \\(3\\)"
diff --git a/gdb/testsuite/gdb.fortran/oop-extend-type.f90 b/gdb/testsuite/gdb.fortran/oop-extend-type.f90
new file mode 100644
index 000000000000..1fe8611f4632
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/oop-extend-type.f90
@@ -0,0 +1,56 @@
+! Copyright 2018 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 testmod
+ implicit none
+ type :: point
+ real :: coo(3)
+ end type
+
+ type, extends(point) :: waypoint
+ real :: angle
+ end type
+
+end module
+
+program testprog
+ use testmod
+ implicit none
+
+ logical l
+ type(waypoint) :: wp
+ type(waypoint), allocatable :: wp_vla(:)
+
+ l = allocated(wp_vla)
+ allocate(wp_vla(3)) ! Before vla allocation
+
+ l = allocated(wp_vla) ! After vla allocation
+ wp%angle = 100.00
+ wp%point%coo(:) = 1.00
+ wp%point%coo(2) = 2.00
+
+ wp_vla(1)%angle = 101.00
+ wp_vla(1)%point%coo(:) = 10.00
+ wp_vla(1)%point%coo(2) = 12.00
+ wp_vla(2)%angle = 102.00
+ wp_vla(2)%point%coo(:) = 20.00
+ wp_vla(2)%point%coo(2) = 22.00
+ wp_vla(3)%angle = 103.00
+ wp_vla(3)%point%coo(:) = 30.00
+ wp_vla(3)%point%coo(2) = 32.00
+
+ print *, wp, wp_vla ! After value assignment
+
+end program
diff --git a/gdb/valops.c b/gdb/valops.c
index c45caefbf1e0..a34e74b2bee9 100644
--- a/gdb/valops.c
+++ b/gdb/valops.c
@@ -2163,6 +2163,12 @@ value_struct_elt (struct value **argp, struct value **args,
if (v)
return v;

+ /* fortran: If it is not a field it is the
+ type name of an inherited structure */
+ v = search_struct_field (name, *argp, t, 1);
+ if (v)
+ return v;
+
/* C++: If it was not found as a data field, then try to
return it as a pointer to a method. */
v = search_struct_method (name, argp, args, 0,

[Pawel Wodkowski]

From: Bernhard Heckel <***@intel.com>

Print base-class of an extended type when doing a ptype.

2016-05-24 Bernhard Heckel <***@intel.com>

gdb/Changelog:
* gdb/f-typeprint.c (f_type_print_derivation_info): New.
(f_type_print_base): Print baseclass info.

gdb/Testsuite/Changelog:
* gdb.fortran/oop-extend-type.exp: Adapt expected results.
---
gdb/f-typeprint.c | 30 +++++++++++++++++++++++++++---
1 file changed, 27 insertions(+), 3 deletions(-)

diff --git a/gdb/f-typeprint.c b/gdb/f-typeprint.c
index 3f13c111ac56..133eaf9b9848 100644
--- a/gdb/f-typeprint.c
+++ b/gdb/f-typeprint.c
@@ -256,6 +256,25 @@ f_type_print_varspec_suffix (struct type *type, struct ui_file *stream,
}
}

+/* If TYPE is an extended type, then print out derivation information.
+
+ A typical output could look like this:
+ "Type, extends(point) :: waypoint"
+ " Type point :: point"
+ " real(kind=4) :: angle"
+ "End Type waypoint"
+ */
+
+static void
+f_type_print_derivation_info (struct type *type, struct ui_file *stream)
+{
+ /* Fortran doesn't support multiple inheritance. */
+ int i = 0;
+
+ if (TYPE_N_BASECLASSES (type) > 0)
+ fprintf_filtered (stream, ", extends(%s) ::", TYPE_NAME (TYPE_BASECLASS (type, i)));
+}
+
/* Print the name of the type (or the ultimate pointer target,
function value or array element), or the description of a
structure or union.
@@ -372,10 +391,15 @@ f_type_print_base (struct type *type, struct ui_file *stream, int show,
case TYPE_CODE_STRUCT:
case TYPE_CODE_UNION:
if (TYPE_CODE (type) == TYPE_CODE_UNION)
- fprintfi_filtered (level, stream, "Type, C_Union :: ");
+ fprintfi_filtered (level, stream, "Type, C_Union ::");
else
- fprintfi_filtered (level, stream, "Type ");
- fputs_filtered (TYPE_NAME (type), stream);
+ fprintfi_filtered (level, stream, "Type");
+
+ if (show > 0)
+ f_type_print_derivation_info (type, stream);
+
+ fprintf_filtered (stream, " %s", TYPE_NAME (type));
+
/* According to the definition,
we only print structure elements in case show > 0. */
if (show > 0)

[Pawel Wodkowski]

From: Bernhard Heckel <***@intel.com>

Like in Ada, we want to be able to set a breakpoint on
nested functions, called "contained routines" in Fortran.

2016-06-30 Bernhard Heckel <***@intel.com>

gdb/Changelog:
* dwarf2read.c (todo)

gdb/Changelog:
* gdb.fortran/nested-funcs.exp: Set breakpoint on contained routines.
---
gdb/dwarf2read.c | 9 +++++++--
gdb/testsuite/gdb.fortran/nested-funcs.exp | 7 +++++++
2 files changed, 14 insertions(+), 2 deletions(-)

diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c
index 88e57d7ab68e..dcf9da8372df 100644
--- a/gdb/dwarf2read.c
+++ b/gdb/dwarf2read.c
@@ -8910,7 +8910,9 @@ 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)
{
/* brobecker/2007-12-26: Normally, only "external" DIEs are part
of the global scope. But in Ada, we want to be able to access
@@ -9206,6 +9208,8 @@ add_partial_subprogram (struct partial_die_info *pdi,
{
if (pdi->tag == DW_TAG_entry_point)
add_partial_entry_point (pdi, lowpc, highpc, set_addrmap, cu);
+ else if (pdi->tag == DW_TAG_subprogram)
+ add_partial_subprogram (pdi, lowpc, highpc, set_addrmap, cu);
pdi = pdi->die_sibling;
}
}
@@ -21543,7 +21547,8 @@ 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
diff --git a/gdb/testsuite/gdb.fortran/nested-funcs.exp b/gdb/testsuite/gdb.fortran/nested-funcs.exp
index 2481d256af69..5e28b0e1a3e2 100755
--- a/gdb/testsuite/gdb.fortran/nested-funcs.exp
+++ b/gdb/testsuite/gdb.fortran/nested-funcs.exp
@@ -29,6 +29,9 @@ 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 "sub_nested_outer"
+gdb_continue_to_breakpoint "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 "sub_nested_inner"
+gdb_continue_to_breakpoint "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"]

[Pawel Wodkowski]

From: 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

[Pawel Wodkowski]

From: Bernhard Heckel <***@intel.com>

Document scope operator in GDB manual.

2016-08-10 Bernhard Heckel <***@intel.com>

gdb/Changelog:
* doc/gdb.texinfo: Describe scope operator.
---
gdb/doc/gdb.texinfo | 3 +++
1 file changed, 3 insertions(+)

diff --git a/gdb/doc/gdb.texinfo b/gdb/doc/gdb.texinfo
index 944a2c438373..29d16cde9396 100644
--- a/gdb/doc/gdb.texinfo
+++ b/gdb/doc/gdb.texinfo
@@ -15882,6 +15882,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 subroutines (internal subroutines).
@end table

@node Fortran Defaults

[Eli Zaretskii]

Date: Fri, 16 Nov 2018 14:10:04 +0100
* doc/gdb.texinfo: Describe scope operator.

Please mention the name of the node where you making the changes, in
parentheses, as if it were a function.

+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).

Please make the lines shorter (less than 70 characters), and please
leave 2 spaces between sentences.

OK with those nits fixed.

Thanks.