* [PATCH v2 3/6] Fortran: Ptype, print type extension.
2017-08-07 9:38 [PATCH v2 0/6] Some Fortran Patches Tim Wiederhake
@ 2017-08-07 9:38 ` Tim Wiederhake
2017-08-07 9:38 ` [PATCH v2 2/6] Fortran: Accessing fields of inherited types via fully qualified name Tim Wiederhake
` (4 subsequent siblings)
5 siblings, 0 replies; 10+ messages in thread
From: Tim Wiederhake @ 2017-08-07 9:38 UTC (permalink / raw)
To: gdb-patches; +Cc: qiyaoltc, Bernhard Heckel
From: Bernhard Heckel <bernhard.heckel@intel.com>
Print base-class of an extended type when doing a ptype.
xxxx-yy-zz Bernhard Heckel <bernhard.heckel@intel.com>
gdb/ChangeLog:
* gdb/f-typeprint.c (f_type_print_derivation_info): New function.
(f_type_print_base): Print baseclass info.
gdb/testsuite/ChangeLog:
* gdb.fortran/oop_extend_type.exp: Adapt expected results.
---
gdb/f-typeprint.c | 31 ++++++++++++++++++++++++---
gdb/testsuite/gdb.fortran/oop_extend_type.exp | 30 ++++++++++++++++++++------
2 files changed, 51 insertions(+), 10 deletions(-)
diff --git a/gdb/f-typeprint.c b/gdb/f-typeprint.c
index 7dbe093..64b2f92 100644
--- a/gdb/f-typeprint.c
+++ b/gdb/f-typeprint.c
@@ -256,6 +256,26 @@ 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_no_tag (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.
@@ -362,10 +382,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_TAG_NAME (type), stream);
+ fprintfi_filtered (level, stream, "Type");
+
+ if (show > 0)
+ f_type_print_derivation_info (type, stream);
+
+ fprintf_filtered (stream, " %s", TYPE_TAG_NAME (type));
+
/* According to the definition,
we only print structure elements in case show > 0. */
if (show > 0)
diff --git a/gdb/testsuite/gdb.fortran/oop_extend_type.exp b/gdb/testsuite/gdb.fortran/oop_extend_type.exp
index a880414..200ce7b 100644
--- a/gdb/testsuite/gdb.fortran/oop_extend_type.exp
+++ b/gdb/testsuite/gdb.fortran/oop_extend_type.exp
@@ -50,11 +50,23 @@ 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"
-gdb_test "ptype wp" \
- [multi_line "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 $" {
@@ -80,11 +92,15 @@ 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\\)"
-gdb_test "ptype wp_vla" \
- [multi_line "type = Type waypoint" \
- " Type point :: point" \
- " $real :: angle" \
- "End 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 $" {
--
2.7.4
^ permalink raw reply [flat|nested] 10+ messages in thread* [PATCH v2 2/6] Fortran: Accessing fields of inherited types via fully qualified name.
2017-08-07 9:38 [PATCH v2 0/6] Some Fortran Patches Tim Wiederhake
2017-08-07 9:38 ` [PATCH v2 3/6] Fortran: Ptype, print type extension Tim Wiederhake
@ 2017-08-07 9:38 ` Tim Wiederhake
2017-08-08 15:00 ` Yao Qi
2017-08-07 9:38 ` [PATCH v2 4/6] Dwarf: Fortran, support DW_TAG_entry_point Tim Wiederhake
` (3 subsequent siblings)
5 siblings, 1 reply; 10+ messages in thread
From: Tim Wiederhake @ 2017-08-07 9:38 UTC (permalink / raw)
To: gdb-patches; +Cc: qiyaoltc, Bernhard Heckel
From: Bernhard Heckel <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)
xxxx-yy-zz Bernhard Heckel <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 file.
* gdb.fortran/oop_extend_type.exp: New file.
---
gdb/f-exp.y | 7 +-
gdb/testsuite/gdb.fortran/oop_extend_type.exp | 97 +++++++++++++++++++++++++++
gdb/testsuite/gdb.fortran/oop_extend_type.f90 | 56 ++++++++++++++++
gdb/valops.c | 6 ++
4 files changed, 164 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 7e9e234..8a71a53 100644
--- a/gdb/f-exp.y
+++ b/gdb/f-exp.y
@@ -608,8 +608,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 0000000..a880414
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/oop_extend_type.exp
@@ -0,0 +1,97 @@
+# Copyright 2017 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"
+gdb_test "ptype wp" \
+ [multi_line "type = Type waypoint" \
+ " Type point :: point" \
+ " $real :: angle" \
+ "End Type waypoint"]
+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\\)"
+gdb_test "ptype wp_vla" \
+ [multi_line "type = Type waypoint" \
+ " Type point :: point" \
+ " $real :: angle" \
+ "End Type waypoint \\(3\\)"]
+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 0000000..95bf4d5
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/oop_extend_type.f90
@@ -0,0 +1,56 @@
+! Copyright 2017 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 8675e6c..2e966da 100644
--- a/gdb/valops.c
+++ b/gdb/valops.c
@@ -2185,6 +2185,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,
--
2.7.4
^ permalink raw reply [flat|nested] 10+ messages in thread* [PATCH v2 4/6] Dwarf: Fortran, support DW_TAG_entry_point.
2017-08-07 9:38 [PATCH v2 0/6] Some Fortran Patches Tim Wiederhake
2017-08-07 9:38 ` [PATCH v2 3/6] Fortran: Ptype, print type extension Tim Wiederhake
2017-08-07 9:38 ` [PATCH v2 2/6] Fortran: Accessing fields of inherited types via fully qualified name Tim Wiederhake
@ 2017-08-07 9:38 ` Tim Wiederhake
2017-08-07 9:38 ` [PATCH v2 1/6] DWARF: Don't add nameless modules to partial symbol table Tim Wiederhake
` (2 subsequent siblings)
5 siblings, 0 replies; 10+ messages in thread
From: Tim Wiederhake @ 2017-08-07 9:38 UTC (permalink / raw)
To: gdb-patches; +Cc: qiyaoltc, Bernhard Heckel
From: Bernhard Heckel <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.
xxxx-yy-zz Bernhard Heckel <bernhard.heckel@intel.com>
Tim Wiederhake <tim.wiederhake@intel.com>
gdb/ChangeLog:
PR fortran/8043
PR fortran/9279
* gdb/dwarf2read.c (add_partial_symbol): Handle DW_TAG_entry_point.
(add_partial_entry_point): New function.
(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 file.
* gdb.fortran/entry_point.exp: New file.
---
gdb/dwarf2read.c | 97 +++++++++++++++++++++++++++++--
gdb/testsuite/gdb.fortran/entry_point.exp | 70 ++++++++++++++++++++++
gdb/testsuite/gdb.fortran/entry_point.f90 | 48 +++++++++++++++
3 files changed, 211 insertions(+), 4 deletions(-)
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 f267366..fe87304 100644
--- a/gdb/dwarf2read.c
+++ b/gdb/dwarf2read.c
@@ -1556,6 +1556,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);
@@ -7132,6 +7136,27 @@ 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. */
+ auto psymbols = pdi->die_parent->is_external
+ ? &objfile->global_psymbols : &objfile->static_psymbols;
+
+ add_psymbol_to_list (actual_name, strlen (actual_name),
+ built_actual_name != NULL, VAR_DOMAIN,
+ LOC_BLOCK, psymbols, addr, cu->language,
+ objfile);
+ }
+ break;
+ }
case DW_TAG_subprogram:
addr = gdbarch_adjust_dwarf2_addr (gdbarch, pdi->lowpc + baseaddr);
if (pdi->is_external || cu->language == language_ada)
@@ -7333,6 +7358,18 @@ 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 == NULL)
+ complaint (&symfile_complaints,
+ _("DW_TAG_entry_point have to have a name"));
+ else
+ add_partial_symbol (pdi, cu);
+}
+
/* Read a partial die corresponding to a subprogram and create a partial
symbol for that subprogram. When the CU language allows it, this
routine also defines a partial symbol for each nested subprogram
@@ -7403,6 +7440,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 != NULL)
+ {
+ 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. */
@@ -8509,6 +8556,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);
@@ -12500,6 +12548,27 @@ 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 its enveloping subprogram and get the lowpc from DWARF. */
+ ret = dwarf2_get_pc_bounds (die->parent, lowpc, highpc, cu, pst);
+ if (ret == PC_BOUNDS_NOT_PRESENT || ret == PC_BOUNDS_INVALID)
+ return ret;
+
+ attr = dwarf2_attr (die, DW_AT_low_pc, cu);
+ if (!attr)
+ {
+ complaint (&symfile_complaints,
+ _("DW_TAG_entry_point is missing DW_AT_low_pc"));
+ return PC_BOUNDS_INVALID;
+ }
+ 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)
{
@@ -16030,6 +16099,7 @@ load_partial_dies (const struct die_reader_specs *reader,
&& abbrev->tag != DW_TAG_constant
&& abbrev->tag != DW_TAG_enumerator
&& abbrev->tag != DW_TAG_subprogram
+ && abbrev->tag != DW_TAG_entry_point
&& abbrev->tag != DW_TAG_lexical_block
&& abbrev->tag != DW_TAG_variable
&& abbrev->tag != DW_TAG_namespace
@@ -16156,6 +16226,7 @@ load_partial_dies (const struct die_reader_specs *reader,
if (load_all
|| abbrev->tag == DW_TAG_constant
|| abbrev->tag == DW_TAG_subprogram
+ || abbrev->tag == DW_TAG_entry_point
|| abbrev->tag == DW_TAG_variable
|| abbrev->tag == DW_TAG_namespace
|| part_die->is_declaration)
@@ -16181,7 +16252,9 @@ load_partial_dies (const struct die_reader_specs *reader,
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. */
+ nested subprograms for instance.
+
+ For Fortran, we need to scan the children of subprogram. */
if (last_die->has_children
&& (load_all
|| last_die->tag == DW_TAG_namespace
@@ -16198,7 +16271,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;
@@ -19059,12 +19134,25 @@ new_symbol_full (struct die_info *die, struct type *type, struct dwarf2_cu *cu,
SYMBOL_ACLASS_INDEX (sym) = LOC_LABEL;
add_symbol_to_list (sym, cu->list_in_scope);
break;
+ case DW_TAG_entry_point:
case DW_TAG_subprogram:
+ /* Don't know any other language than fortran which is
+ using DW_TAG_entry_point. */
+ if ((die->tag == DW_TAG_entry_point)
+ && (cu->language != language_fortran))
+ break;
+
/* SYMBOL_BLOCK_VALUE (sym) will be filled in later by
finish_block. */
SYMBOL_ACLASS_INDEX (sym) = LOC_BLOCK;
- attr2 = dwarf2_attr (die, DW_AT_external, cu);
- if ((attr2 && (DW_UNSND (attr2) != 0))
+
+ /* 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->tag == DW_TAG_entry_point ? die->parent
+ : die, DW_AT_external, cu);
+ if ((attr2 != NULL && (DW_UNSND (attr2) != 0))
|| cu->language == language_ada)
{
/* Subprograms marked external are stored as a global symbol.
@@ -19744,6 +19832,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 0000000..950ffe2
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/entry_point.exp
@@ -0,0 +1,70 @@
+# Copyright 2017 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 "baz"
+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 0000000..1d43930
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/entry_point.f90
@@ -0,0 +1,48 @@
+! Copyright 2017 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 baz(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 baz(J)
+ goto 200
+
+1000 A = C + 1
+ C = J * 1.5
+
+ return
+ end subroutine
--
2.7.4
^ permalink raw reply [flat|nested] 10+ messages in thread* [PATCH v2 1/6] DWARF: Don't add nameless modules to partial symbol table.
2017-08-07 9:38 [PATCH v2 0/6] Some Fortran Patches Tim Wiederhake
` (2 preceding siblings ...)
2017-08-07 9:38 ` [PATCH v2 4/6] Dwarf: Fortran, support DW_TAG_entry_point Tim Wiederhake
@ 2017-08-07 9:38 ` Tim Wiederhake
2017-08-07 22:08 ` Yao Qi
2017-08-07 9:38 ` [PATCH v2 5/6] Fortran: Enable setting breakpoint on nested functions Tim Wiederhake
2017-08-07 9:38 ` [PATCH v2 6/6] Fortran: Nested functions, add scope parameter Tim Wiederhake
5 siblings, 1 reply; 10+ messages in thread
From: Tim Wiederhake @ 2017-08-07 9:38 UTC (permalink / raw)
To: gdb-patches; +Cc: qiyaoltc, Bernhard Heckel
From: Bernhard Heckel <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, e.g. as generated by ifort. This patch fixes it.
BLOCK DATA is used for one-time initialization of non-pointer variables in
named common blocks.
xxxx-yy-zz Bernhard Heckel <bernhard.heckel@intel.com>
gdb/ChangeLog:
* dwarf2read.c (add_partial_symbol): Skip nameless modules.
gdb/testsuite/ChangeLog:
* gdb.fortran/block-data.f: New file.
* gdb.fortran/block-data.exp: New file.
---
gdb/dwarf2read.c | 14 +++++---
gdb/testsuite/gdb.fortran/block-data.exp | 49 ++++++++++++++++++++++++++++
gdb/testsuite/gdb.fortran/block-data.f | 56 ++++++++++++++++++++++++++++++++
3 files changed, 114 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 2c2ecda..f267366 100644
--- a/gdb/dwarf2read.c
+++ b/gdb/dwarf2read.c
@@ -7245,11 +7245,15 @@ 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,
- &objfile->global_psymbols,
- 0, cu->language, objfile);
+ /* In Fortran 77 there might be a "BLOCK DATA" module available without
+ any name, as generated by iFort. If so, we skip the module as it
+ doesn't bring any value. */
+ if (actual_name != NULL)
+ add_psymbol_to_list (actual_name, strlen (actual_name),
+ built_actual_name != NULL,
+ MODULE_DOMAIN, LOC_TYPEDEF,
+ &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 0000000..9e1f6bd
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/block-data.exp
@@ -0,0 +1,49 @@
+# Copyright 2017 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/>.
+
+# 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 0000000..3bc5eb6
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/block-data.f
@@ -0,0 +1,56 @@
+c Copyright 2017 Free Software Foundation, Inc.
+c
+c This program is free software; you can redistribute it and/or modify
+c it under the terms of the GNU General Public License as published by
+c the Free Software Foundation; either version 3 of the License, or
+c (at your option) any later version.
+c
+c This program is distributed in the hope that it will be useful,
+c but WITHOUT ANY WARRANTY; without even the implied warranty of
+c MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+c GNU General Public License for more details.
+c
+c You should have received a copy of the GNU General Public License
+c along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+c Test if GDB can handle block data without global name
+
+c 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
+
+c 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
+
+c 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
--
2.7.4
^ permalink raw reply [flat|nested] 10+ messages in thread* Re: [PATCH v2 1/6] DWARF: Don't add nameless modules to partial symbol table.
2017-08-07 9:38 ` [PATCH v2 1/6] DWARF: Don't add nameless modules to partial symbol table Tim Wiederhake
@ 2017-08-07 22:08 ` Yao Qi
0 siblings, 0 replies; 10+ messages in thread
From: Yao Qi @ 2017-08-07 22:08 UTC (permalink / raw)
To: Tim Wiederhake; +Cc: gdb-patches, Bernhard Heckel
On Mon, Aug 7, 2017 at 10:37 AM, Tim Wiederhake
<tim.wiederhake@intel.com> wrote:
> From: Bernhard Heckel <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, e.g. as generated by ifort. This patch fixes it.
>
> BLOCK DATA is used for one-time initialization of non-pointer variables in
> named common blocks.
>
> xxxx-yy-zz Bernhard Heckel <bernhard.heckel@intel.com>
>
> gdb/ChangeLog:
> * dwarf2read.c (add_partial_symbol): Skip nameless modules.
>
> gdb/testsuite/ChangeLog:
> * gdb.fortran/block-data.f: New file.
> * gdb.fortran/block-data.exp: New file.
>
Patch is good to me.
--
Yao (齐尧)
^ permalink raw reply [flat|nested] 10+ messages in thread
* [PATCH v2 5/6] Fortran: Enable setting breakpoint on nested functions.
2017-08-07 9:38 [PATCH v2 0/6] Some Fortran Patches Tim Wiederhake
` (3 preceding siblings ...)
2017-08-07 9:38 ` [PATCH v2 1/6] DWARF: Don't add nameless modules to partial symbol table Tim Wiederhake
@ 2017-08-07 9:38 ` Tim Wiederhake
2017-08-07 9:38 ` [PATCH v2 6/6] Fortran: Nested functions, add scope parameter Tim Wiederhake
5 siblings, 0 replies; 10+ messages in thread
From: Tim Wiederhake @ 2017-08-07 9:38 UTC (permalink / raw)
To: gdb-patches; +Cc: qiyaoltc, Bernhard Heckel
From: Bernhard Heckel <bernhard.heckel@intel.com>
Like in Ada, we want to be able to set a breakpoint on nested functions,
called "contained routines" in Fortran.
xxxx-yy-zz Bernhard Heckel <bernhard.heckel@intel.com>
gdb/ChangeLog:
* dwarf2read.c (add_partial_symbol): Enable for Fortran as well.
(new_symbol_full): Same.
(add_partial_subprogram): Check for subprogram tag.
gdb/testsuite/ChangeLog:
* gdb.fortran/nested-funcs.exp: Set breakpoint on contained routines.
---
gdb/dwarf2read.c | 9 +++++++--
gdb/testsuite/gdb.fortran/nested-funcs.exp | 8 ++++++++
2 files changed, 15 insertions(+), 2 deletions(-)
mode change 100755 => 100644 gdb/testsuite/gdb.fortran/nested-funcs.exp
diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c
index fe87304..3d6a869 100644
--- a/gdb/dwarf2read.c
+++ b/gdb/dwarf2read.c
@@ -7159,7 +7159,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);
- 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
@@ -7447,6 +7449,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;
}
}
@@ -19153,7 +19157,8 @@ new_symbol_full (struct die_info *die, struct type *type, struct dwarf2_cu *cu,
attr2 = dwarf2_attr (die->tag == DW_TAG_entry_point ? die->parent
: die, DW_AT_external, cu);
if ((attr2 != NULL && (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
old mode 100755
new mode 100644
index f6a5335..4c2ee2a
--- a/gdb/testsuite/gdb.fortran/nested-funcs.exp
+++ b/gdb/testsuite/gdb.fortran/nested-funcs.exp
@@ -30,6 +30,10 @@ 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"
+
# Test if we can access local and
# non-local variables defined one level up.
gdb_breakpoint [gdb_get_line_number "! BP_outer"]
@@ -43,6 +47,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"]
--
2.7.4
^ permalink raw reply [flat|nested] 10+ messages in thread* [PATCH v2 6/6] Fortran: Nested functions, add scope parameter.
2017-08-07 9:38 [PATCH v2 0/6] Some Fortran Patches Tim Wiederhake
` (4 preceding siblings ...)
2017-08-07 9:38 ` [PATCH v2 5/6] Fortran: Enable setting breakpoint on nested functions Tim Wiederhake
@ 2017-08-07 9:38 ` Tim Wiederhake
2017-08-07 16:15 ` Eli Zaretskii
5 siblings, 1 reply; 10+ messages in thread
From: Tim Wiederhake @ 2017-08-07 9:38 UTC (permalink / raw)
To: gdb-patches; +Cc: qiyaoltc, Bernhard Heckel
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.
xxxx-yy-zz Bernhard Heckel <bernhard.heckel@intel.com>
gdb/ChangeLog:
* doc/gdb.texinfo: Describe scope operator.
* dwarf2read.c: (partial_die_parent_scope): Add prefix for Fortran
subroutines.
(process_die): Same.
(determine_prefix): Same.
gdb/testsuite/ChangeLog:
* gdb.fortran/nested-funcs.exp: Add tests for nested subroutines.
Adjust existing tests to include prefix.
* gdb.fortran/nested-funcs.f90: Add nested subroutines.
---
gdb/doc/gdb.texinfo | 3 ++
gdb/dwarf2read.c | 26 +++++++++++-
gdb/testsuite/gdb.fortran/nested-funcs.exp | 28 +++++++++++--
gdb/testsuite/gdb.fortran/nested-funcs.f90 | 66 ++++++++++++++++++++++++++++--
4 files changed, 114 insertions(+), 9 deletions(-)
mode change 100755 => 100644 gdb/testsuite/gdb.fortran/nested-funcs.f90
diff --git a/gdb/doc/gdb.texinfo b/gdb/doc/gdb.texinfo
index 5f55a67..83ea264 100644
--- a/gdb/doc/gdb.texinfo
+++ b/gdb/doc/gdb.texinfo
@@ -15259,6 +15259,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 (internal) subroutines.
@end table
@node Fortran Defaults
diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c
index 3d6a869..af66c13 100644
--- a/gdb/dwarf2read.c
+++ b/gdb/dwarf2read.c
@@ -7042,6 +7042,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;
@@ -7051,7 +7052,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;
@@ -8560,8 +8564,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;
@@ -20167,6 +20176,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 4c2ee2a..0c8a416 100644
--- a/gdb/testsuite/gdb.fortran/nested-funcs.exp
+++ b/gdb/testsuite/gdb.fortran/nested-funcs.exp
@@ -31,8 +31,8 @@ if ![runto MAIN__] then {
}
# 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.
@@ -43,13 +43,16 @@ gdb_test "set index = 42"
gdb_test "print index" "= 42" "print index at BP_outer, manipulated"
gdb_test "print local_int" "= 19" "print local_int in outer function"
+
# Non-local variable should be affected in one frame up as well.
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.
@@ -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"
gdb_test "print local_int" "= 17" "print local_int in inner function"
+
# Test if local variable is still correct.
gdb_breakpoint [gdb_get_line_number "! BP_outer_2"]
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
old mode 100755
new mode 100644
index 0e99996..e7289de
--- 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
! 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 +78,14 @@ program TestNestedFuncs
END TYPE t_State
TYPE (t_State) :: v_state
- integer index
+ integer index, local_int
+ local_int = 14
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
^ permalink raw reply [flat|nested] 10+ messages in thread* Re: [PATCH v2 6/6] Fortran: Nested functions, add scope parameter.
2017-08-07 9:38 ` [PATCH v2 6/6] Fortran: Nested functions, add scope parameter Tim Wiederhake
@ 2017-08-07 16:15 ` Eli Zaretskii
0 siblings, 0 replies; 10+ messages in thread
From: Eli Zaretskii @ 2017-08-07 16:15 UTC (permalink / raw)
To: Tim Wiederhake; +Cc: gdb-patches, qiyaoltc, bernhard.heckel
> From: Tim Wiederhake <tim.wiederhake@intel.com>
> Cc: qiyaoltc@gmail.com, Bernhard Heckel <bernhard.heckel@intel.com>
> Date: Mon, 7 Aug 2017 11:37:34 +0200
>
> From: Bernhard Heckel <bernhard.heckel@intel.com>
>
> gdb/ChangeLog:
> * doc/gdb.texinfo: Describe scope operator.
This should go into gdb/doc/ChangeLog, and it should mention the node
in which the change is made (in parentheses).
> --- a/gdb/doc/gdb.texinfo
> +++ b/gdb/doc/gdb.texinfo
> @@ -15259,6 +15259,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 (internal) subroutines.
> @end table
This part is OK, thanks.
^ permalink raw reply [flat|nested] 10+ messages in thread