[PATCH v4 0/3] Fortran entry and DW_TAG_entry_point

[PATCH v4 0/3] Fortran entry and DW_TAG_entry_point

[Nils-Christian Kempke via Gdb-patches]

Hi,

please find attached version 4 of this series.  Changes from v3 mainly
try to incorporate Andrew's comments here:
https://sourceware.org/pipermail/gdb-patches/2022-July/190630.html

Changes since v3:

  * Patch 1 and 2 were introduced in order to not clutter patch 3 too
  much.

  * Patch 1 was introduced because of some code duplication in v3.  It
  outsources some code from dwarf2_get_pc_bounds into a separate function
  to make the addition of the entry point handling easier.  It should not
  contain any functional changes.

  * Patch 2 was introduced because, as Andrew noted correctly,
  dwarf2_get_pc_bounds was unconditionally writing to some pointer
  without checking it being non-null, an error I had replicated in
  my own patch.  I found it appropriate to make a separate patch for
  this change.  The assert should only trigger when we are attempting
  to dereference a nullptr - which should have killed GDB anyway.

  * Patch 3 still contains the addition of the DW_TAG_entry_point.  I
  rebased it on patch 1 and 2.  It relies heavily on patch 1 and its
  refactoring.  It contains all leftover fixes for Andrew's comments.
  Most importantly it now applies GNU coding style in the example and I
  changed '__asm__' to 'asm'.  I also added the missing use of int_size
  in dw2-entry-points.exp.
  

v1 can be found here:
https://sourceware.org/pipermail/gdb-patches/2022-March/186900.html

v2 can be found here:
https://sourceware.org/pipermail/gdb-patches/2022-April/187853.html

v3 can be found here:
https://sourceware.org/pipermail/gdb-patches/2022-July/190556.html

This was tested against regressions on Ubuntu 20 x86_64 with the boards
unix, unix/-m32, native-gdbserver, and native-extended-gdbserver.

Thanks,

Nils

Nils-Christian Kempke (3):
  gdb, dwarf: move part of dwarf2_get_pc_bounds into separate function
  gdb, dwarf: add assert to dwarf2_get_pc_bounds
  dwarf, fortran: add support for DW_TAG_entry_point

 gdb/dwarf2/abbrev.c                           |   1 +
 gdb/dwarf2/cooked-index.h                     |   3 +-
 gdb/dwarf2/index-write.c                      |   3 +-
 gdb/dwarf2/read.c                             | 132 +++++++++--
 gdb/testsuite/gdb.dwarf2/dw2-entry-points.c   |  43 ++++
 gdb/testsuite/gdb.dwarf2/dw2-entry-points.exp | 215 ++++++++++++++++++
 gdb/testsuite/gdb.fortran/entry-point.exp     |  84 +++++++
 gdb/testsuite/gdb.fortran/entry-point.f90     |  67 ++++++
 8 files changed, 524 insertions(+), 24 deletions(-)
 create mode 100644 gdb/testsuite/gdb.dwarf2/dw2-entry-points.c
 create mode 100644 gdb/testsuite/gdb.dwarf2/dw2-entry-points.exp
 create mode 100644 gdb/testsuite/gdb.fortran/entry-point.exp
 create mode 100644 gdb/testsuite/gdb.fortran/entry-point.f90

-- 
2.25.1

Intel Deutschland GmbH
Registered Address: Am Campeon 10, 85579 Neubiberg, Germany
Tel: +49 89 99 8853-0, www.intel.de <http://www.intel.de>
Managing Directors: Christin Eisenschmid, Sharon Heck, Tiffany Doon Silva  
Chairperson of the Supervisory Board: Nicole Lau
Registered Office: Munich
Commercial Register: Amtsgericht Muenchen HRB 186928

[PATCH v4 1/3] gdb, dwarf: move part of dwarf2_get_pc_bounds into separate function

[Nils-Christian Kempke via Gdb-patches]

This commit is in preparation of the next commit.  There, we will add
a second variation to retrieve the pc bounds for DIEs tagged with
DW_TAG_entry_point.  Instead of dwarf_get_pc_bounds_ranges_or_highlow_pc
we will call a separate method for entry points.  As the validity checks
at the endo f dwarf2_get_pc_bounds are the same for both variants,
we introduced the new dwarf_get_pc_bounds_ranges_or_highlow_pc method,
outsourcing part of dwarf2_get_pc_bounds.

This commit should have no functional impact on GDB.

Signed-off-by: Nils-Christian Kempke <nils-christian.kempke@intel.com>
---
 gdb/dwarf2/read.c | 71 +++++++++++++++++++++++++++++++++--------------
 1 file changed, 50 insertions(+), 21 deletions(-)

diff --git a/gdb/dwarf2/read.c b/gdb/dwarf2/read.c
index 5ca787cc095..7ea6c1a7831 100644
--- a/gdb/dwarf2/read.c
+++ b/gdb/dwarf2/read.c
@@ -12978,20 +12978,19 @@ dwarf2_ranges_read_low_addrs (unsigned offset, struct dwarf2_cu *cu,
     });
 }
 
-/* Get low and high pc attributes from a die.  See enum pc_bounds_kind
-   definition for the return value.  *LOWPC and *HIGHPC are set iff
-   neither PC_BOUNDS_NOT_PRESENT nor PC_BOUNDS_INVALID are returned.  */
+/* Determine the low and high pc using the DW_AT_low_pc and DW_AT_high_pc or
+   DW_AT_ranges attributes of a DIE.  */
 
-static enum pc_bounds_kind
-dwarf2_get_pc_bounds (struct die_info *die, CORE_ADDR *lowpc,
-		      CORE_ADDR *highpc, struct dwarf2_cu *cu,
-		      addrmap *map, void *datum)
+static pc_bounds_kind
+dwarf_get_pc_bounds_ranges_or_highlow_pc (die_info *die, CORE_ADDR *low,
+					  CORE_ADDR *high, dwarf2_cu *cu,
+					  addrmap *map, void *datum)
 {
-  dwarf2_per_objfile *per_objfile = cu->per_objfile;
+  gdb_assert (low != nullptr);
+  gdb_assert (high != nullptr);
+
   struct attribute *attr;
   struct attribute *attr_high;
-  CORE_ADDR low = 0;
-  CORE_ADDR high = 0;
   enum pc_bounds_kind ret;
 
   attr_high = dwarf2_attr (die, DW_AT_high_pc, cu);
@@ -13000,17 +12999,19 @@ dwarf2_get_pc_bounds (struct die_info *die, CORE_ADDR *lowpc,
       attr = dwarf2_attr (die, DW_AT_low_pc, cu);
       if (attr != nullptr)
 	{
-	  low = attr->as_address ();
-	  high = attr_high->as_address ();
+	  *low = attr->as_address ();
+	  *high = attr_high->as_address ();
 	  if (cu->header.version >= 4 && attr_high->form_is_constant ())
-	    high += low;
+	    *high += *low;
+
+	  /* Found consecutive range of addresses.  */
+	  ret = PC_BOUNDS_HIGH_LOW;
 	}
       else
-	/* Found high w/o low attribute.  */
-	return PC_BOUNDS_INVALID;
-
-      /* Found consecutive range of addresses.  */
-      ret = PC_BOUNDS_HIGH_LOW;
+	{
+	  /* Found high w/o low attribute.  */
+	  ret = PC_BOUNDS_INVALID;
+	}
     }
   else
     {
@@ -13028,16 +13029,44 @@ dwarf2_get_pc_bounds (struct die_info *die, CORE_ADDR *lowpc,
 
 	  /* Value of the DW_AT_ranges attribute is the offset in the
 	     .debug_ranges section.  */
-	  if (!dwarf2_ranges_read (ranges_offset, &low, &high, cu,
+	  if (!dwarf2_ranges_read (ranges_offset, low, high, cu,
 				   map, datum, die->tag))
 	    return PC_BOUNDS_INVALID;
 	  /* Found discontinuous range of addresses.  */
 	  ret = PC_BOUNDS_RANGES;
 	}
       else
-	return PC_BOUNDS_NOT_PRESENT;
+	{
+	  /* Could not find high_pc or ranges attributed and thus no bounds
+	     pair.  */
+	  ret = PC_BOUNDS_NOT_PRESENT;
+	}
     }
 
+    return ret;
+}
+
+/* Get low and high pc attributes from a die.  See enum pc_bounds_kind
+   definition for the return value.  *LOWPC and *HIGHPC are set iff
+   neither PC_BOUNDS_NOT_PRESENT nor PC_BOUNDS_INVALID are returned.  */
+
+static enum pc_bounds_kind
+dwarf2_get_pc_bounds (struct die_info *die, CORE_ADDR *lowpc,
+		      CORE_ADDR *highpc, struct dwarf2_cu *cu,
+		      addrmap *map, void *datum)
+{
+  dwarf2_per_objfile *per_objfile = cu->per_objfile;
+
+  CORE_ADDR low = 0;
+  CORE_ADDR high = 0;
+  enum pc_bounds_kind ret;
+
+  ret = dwarf_get_pc_bounds_ranges_or_highlow_pc (die, &low, &high, cu, map,
+						  datum);
+
+  if (ret == PC_BOUNDS_NOT_PRESENT || ret == PC_BOUNDS_INVALID)
+    return ret;
+
   /* partial_die_info::read has also the strict LOW < HIGH requirement.  */
   if (high <= low)
     return PC_BOUNDS_INVALID;
@@ -13054,7 +13083,7 @@ dwarf2_get_pc_bounds (struct die_info *die, CORE_ADDR *lowpc,
     return PC_BOUNDS_INVALID;
 
   *lowpc = low;
-  if (highpc)
+  if (highpc != nullptr)
     *highpc = high;
   return ret;
 }
-- 
2.25.1

Intel Deutschland GmbH
Registered Address: Am Campeon 10, 85579 Neubiberg, Germany
Tel: +49 89 99 8853-0, www.intel.de <http://www.intel.de>
Managing Directors: Christin Eisenschmid, Sharon Heck, Tiffany Doon Silva  
Chairperson of the Supervisory Board: Nicole Lau
Registered Office: Munich
Commercial Register: Amtsgericht Muenchen HRB 186928

[PATCH v4 2/3] gdb, dwarf: add assert to dwarf2_get_pc_bounds

[Nils-Christian Kempke via Gdb-patches]

In dwarf2_get_pc_bounds we were writing unchecked to *lowpc.  This
commit adds a gdb_assert to first check that lowpc != nullptr.

Signed-off-by: Nils-Christian Kempke <nils-christian.kempke@intel.com>
---
 gdb/dwarf2/read.c | 1 +
 1 file changed, 1 insertion(+)

diff --git a/gdb/dwarf2/read.c b/gdb/dwarf2/read.c
index 7ea6c1a7831..456caf364a0 100644
--- a/gdb/dwarf2/read.c
+++ b/gdb/dwarf2/read.c
@@ -13082,6 +13082,7 @@ dwarf2_get_pc_bounds (struct die_info *die, CORE_ADDR *lowpc,
   if (low == 0 && !per_objfile->per_bfd->has_section_at_zero)
     return PC_BOUNDS_INVALID;
 
+  gdb_assert (lowpc != nullptr);
   *lowpc = low;
   if (highpc != nullptr)
     *highpc = high;
-- 
2.25.1

Intel Deutschland GmbH
Registered Address: Am Campeon 10, 85579 Neubiberg, Germany
Tel: +49 89 99 8853-0, www.intel.de <http://www.intel.de>
Managing Directors: Christin Eisenschmid, Sharon Heck, Tiffany Doon Silva  
Chairperson of the Supervisory Board: Nicole Lau
Registered Office: Munich
Commercial Register: Amtsgericht Muenchen HRB 186928

[PATCH v4 3/3] dwarf, fortran: add support for DW_TAG_entry_point

[Nils-Christian Kempke via Gdb-patches]

Fortran provides additional entry points for subroutines and functions.
These entry points may use only a subset (or a different set) of the
parameters of the original subroutine.  The entry points may be described
via the DWARF tag DW_TAG_entry_point.

This commit adds support for parsing the DW_TAG_entry_point DWARF tag.
Currently, between ifx/ifort/gfortran, only ifort is actually emitting
this tag.  Both, ifx and gfortran use the DW_TAG_subprogram tag as
workaround/alternative.  Thus, this patch really only adds more ifort
support.  Even so, some of the attached tests still fail for ifort, due
to some wrong line info generated for the entry points in ifort.

After this patch it is possible to set a breakpoint in gdb with the
ifort compiled example at the entry points 'foo' and 'foobar', which was not
possible before.

As gcc and ifx do not emit the tag I also added a test to gdb.dwarf2
which uses some underlying c compiled code and adds some Fortran style DWARF
to it emitting the DW_TAG_entry_point.  Before this patch it was not
possible to actually define breakpoint at the entry point tags.

For gfortran there actually exists a bug on bugzilla, asking for the use
of DW_TAG_entry_point over DW_TAG_subprogram:

https://gcc.gnu.org/bugzilla/show_bug.cgi?id=37134

This patch was originally posted here

https://sourceware.org/legacy-ml/gdb-patches/2017-07/msg00317.html

but its review/pinging got lost after a while.  I reworked it to fit the
current GDB.

Co-authored-by: Bernhard Heckel <bernhard.heckel@intel.com>
Co-authored-by: Tim Wiederhake  <tim.wiederhake@intel.com>
---
 gdb/dwarf2/abbrev.c                           |   1 +
 gdb/dwarf2/cooked-index.h                     |   3 +-
 gdb/dwarf2/index-write.c                      |   3 +-
 gdb/dwarf2/read.c                             |  64 +++++-
 gdb/testsuite/gdb.dwarf2/dw2-entry-points.c   |  43 ++++
 gdb/testsuite/gdb.dwarf2/dw2-entry-points.exp | 215 ++++++++++++++++++
 gdb/testsuite/gdb.fortran/entry-point.exp     |  84 +++++++
 gdb/testsuite/gdb.fortran/entry-point.f90     |  67 ++++++
 8 files changed, 475 insertions(+), 5 deletions(-)
 create mode 100644 gdb/testsuite/gdb.dwarf2/dw2-entry-points.c
 create mode 100644 gdb/testsuite/gdb.dwarf2/dw2-entry-points.exp
 create mode 100644 gdb/testsuite/gdb.fortran/entry-point.exp
 create mode 100644 gdb/testsuite/gdb.fortran/entry-point.f90

diff --git a/gdb/dwarf2/abbrev.c b/gdb/dwarf2/abbrev.c
index 4ca27eaa7e0..f9f87203e3e 100644
--- a/gdb/dwarf2/abbrev.c
+++ b/gdb/dwarf2/abbrev.c
@@ -88,6 +88,7 @@ tag_interesting_for_index (dwarf_tag tag)
     case DW_TAG_base_type:
     case DW_TAG_class_type:
     case DW_TAG_constant:
+    case DW_TAG_entry_point:
     case DW_TAG_enumeration_type:
     case DW_TAG_enumerator:
     case DW_TAG_imported_declaration:
diff --git a/gdb/dwarf2/cooked-index.h b/gdb/dwarf2/cooked-index.h
index 439cbb19fa7..e63d3001d2a 100644
--- a/gdb/dwarf2/cooked-index.h
+++ b/gdb/dwarf2/cooked-index.h
@@ -113,7 +113,8 @@ struct cooked_index_entry : public allocate_on_obstack
 		|| tag == DW_TAG_constant
 		|| tag == DW_TAG_enumerator);
       case FUNCTIONS_DOMAIN:
-	return tag == DW_TAG_subprogram;
+	return (tag == DW_TAG_subprogram
+		|| tag == DW_TAG_entry_point);
       case TYPES_DOMAIN:
 	return tag_is_type (tag);
       case MODULES_DOMAIN:
diff --git a/gdb/dwarf2/index-write.c b/gdb/dwarf2/index-write.c
index efd154d41df..59202fa5e89 100644
--- a/gdb/dwarf2/index-write.c
+++ b/gdb/dwarf2/index-write.c
@@ -1128,7 +1128,8 @@ write_cooked_index (cooked_index_vector *table,
       const char *name = entry->full_name (&symtab->m_string_obstack);
 
       gdb_index_symbol_kind kind;
-      if (entry->tag == DW_TAG_subprogram)
+      if (entry->tag == DW_TAG_subprogram
+	  || entry->tag == DW_TAG_entry_point)
 	kind = GDB_INDEX_SYMBOL_KIND_FUNCTION;
       else if (entry->tag == DW_TAG_variable
 	       || entry->tag == DW_TAG_constant
diff --git a/gdb/dwarf2/read.c b/gdb/dwarf2/read.c
index 456caf364a0..5e633ac4207 100644
--- a/gdb/dwarf2/read.c
+++ b/gdb/dwarf2/read.c
@@ -8591,6 +8591,7 @@ process_die (struct die_info *die, struct dwarf2_cu *cu)
 	  && die->parent->tag == DW_TAG_subprogram)
 	cu->processing_has_namespace_info = true;
       /* Fall through.  */
+    case DW_TAG_entry_point:
     case DW_TAG_inlined_subroutine:
       read_func_scope (die, cu);
       break;
@@ -8707,6 +8708,7 @@ die_needs_namespace (struct die_info *die, struct dwarf2_cu *cu)
     case DW_TAG_enumerator:
     case DW_TAG_subprogram:
     case DW_TAG_inlined_subroutine:
+    case DW_TAG_entry_point:
     case DW_TAG_member:
     case DW_TAG_imported_declaration:
       return 1;
@@ -12978,6 +12980,41 @@ dwarf2_ranges_read_low_addrs (unsigned offset, struct dwarf2_cu *cu,
     });
 }
 
+/* Determine the low and high pc of a DW_TAG_entry_point.  */
+
+static pc_bounds_kind
+dwarf2_get_pc_bounds_entry_point (die_info *die, CORE_ADDR *low,
+				  CORE_ADDR *high, dwarf2_cu *cu)
+{
+  gdb_assert (low != nullptr);
+  gdb_assert (high != nullptr);
+
+  if (die->parent->tag != DW_TAG_subprogram)
+    {
+      complaint (_("DW_TAG_entry_point not embedded in DW_TAG_subprogram"));
+      return PC_BOUNDS_INVALID;
+    }
+
+  /* A DW_TAG_entry_point is embedded in an subprogram.  Therefore, we can use
+     the highpc from its enveloping subprogram and get the lowpc from
+     DWARF.  */
+  const enum pc_bounds_kind bounds_kind = dwarf2_get_pc_bounds (die->parent,
+								low, high,
+								cu, nullptr,
+								nullptr);
+  if (bounds_kind == PC_BOUNDS_INVALID || bounds_kind == PC_BOUNDS_NOT_PRESENT)
+    return bounds_kind;
+
+  attribute *attr_low = dwarf2_attr (die, DW_AT_low_pc, cu);
+  if (!attr_low)
+    {
+      complaint (_("DW_TAG_entry_point is missing DW_AT_low_pc"));
+      return PC_BOUNDS_INVALID;
+    }
+  *low = attr_low->as_address ();
+  return bounds_kind;
+}
+
 /* Determine the low and high pc using the DW_AT_low_pc and DW_AT_high_pc or
    DW_AT_ranges attributes of a DIE.  */
 
@@ -13061,8 +13098,11 @@ dwarf2_get_pc_bounds (struct die_info *die, CORE_ADDR *lowpc,
   CORE_ADDR high = 0;
   enum pc_bounds_kind ret;
 
-  ret = dwarf_get_pc_bounds_ranges_or_highlow_pc (die, &low, &high, cu, map,
-						  datum);
+  if (die->tag == DW_TAG_entry_point)
+    ret = dwarf2_get_pc_bounds_entry_point (die, &low, &high, cu);
+  else
+    ret = dwarf_get_pc_bounds_ranges_or_highlow_pc (die, &low, &high, cu, map,
+						    datum);
 
   if (ret == PC_BOUNDS_NOT_PRESENT || ret == PC_BOUNDS_INVALID)
     return ret;
@@ -20774,6 +20814,20 @@ new_symbol (struct die_info *die, struct type *type, struct dwarf2_cu *cu,
 	  sym->set_domain (LABEL_DOMAIN);
 	  add_symbol_to_list (sym, cu->list_in_scope);
 	  break;
+	case DW_TAG_entry_point:
+	  /* SYMBOL_BLOCK_VALUE (sym) will be filled in later by
+	     finish_block.  */
+	  sym->set_aclass_index (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 != nullptr && attr2->as_boolean ())
+	    list_to_add = cu->get_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.  */
@@ -21478,6 +21532,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:
@@ -21797,12 +21852,15 @@ determine_prefix (struct die_info *die, struct dwarf2_cu *cu)
 	return "";
       case DW_TAG_subprogram:
 	/* Nested subroutines in Fortran get a prefix with the name
-	   of the parent's subroutine.  */
+	   of the parent's subroutine.  Entry points are prefixed by the
+	   parent's namespace.  */
 	if (cu->lang () == language_fortran)
 	  {
 	    if ((die->tag ==  DW_TAG_subprogram)
 		&& (dwarf2_name (parent, cu) != NULL))
 	      return dwarf2_name (parent, cu);
+	    else if (die->tag == DW_TAG_entry_point)
+	      return determine_prefix (parent, cu);
 	  }
 	return "";
       case DW_TAG_enumeration_type:
diff --git a/gdb/testsuite/gdb.dwarf2/dw2-entry-points.c b/gdb/testsuite/gdb.dwarf2/dw2-entry-points.c
new file mode 100644
index 00000000000..3dfec5d14f6
--- /dev/null
+++ b/gdb/testsuite/gdb.dwarf2/dw2-entry-points.c
@@ -0,0 +1,43 @@
+/* Copyright 2022 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/>.  */
+
+/* In the generated DWARF, we'll use the locations of foo_entry_label and
+   foobar_entry_label as the low_pc's of our entry point TAGs.  */
+
+int I = 0;
+int J = 0;
+int K = 0;
+
+__attribute__ ((noinline))
+void
+bar_helper (void)
+{
+  asm ("bar_helper_label: .globl bar_helper_label");
+  I++;
+  J++;
+  asm ("foo_entry_label: .globl foo_entry_label");
+  J++;
+  K++;
+  asm ("foobar_entry_label: .globl foobar_entry_label");
+}
+
+int
+main (void)
+{
+  asm ("main_label: .globl main_label");
+  bar_helper ();
+
+  return 0;
+}
diff --git a/gdb/testsuite/gdb.dwarf2/dw2-entry-points.exp b/gdb/testsuite/gdb.dwarf2/dw2-entry-points.exp
new file mode 100644
index 00000000000..096198b288b
--- /dev/null
+++ b/gdb/testsuite/gdb.dwarf2/dw2-entry-points.exp
@@ -0,0 +1,215 @@
+# Copyright 2022 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/>.
+
+# Test that the DW_TAG_entry_point is handled properly by GDB and that we can
+# set breakpoints on function entry points.
+
+load_lib dwarf.exp
+
+# This test can only be run on targets that support DWARF-2 and use
+# gas.
+if {![dwarf2_support]} {
+    return 0
+}
+
+standard_testfile .c -dw.S
+
+if { [prepare_for_testing "failed to prepare" ${testfile} ${srcfile}] } {
+	return -1
+}
+
+# Make some DWARF for the test.
+set asm_file [standard_output_file $srcfile2]
+Dwarf::assemble $asm_file {
+    global srcfile
+    declare_labels int_label int2_label
+
+    get_func_info main
+    get_func_info bar_helper
+
+    set int_size [get_sizeof "int" 4]
+
+    set prog_line 1
+    set bar_line 2
+    set foo_line 3
+    set foobar_line 4
+
+    set global_I [gdb_target_symbol I]
+    set global_J [gdb_target_symbol J]
+    set global_K [gdb_target_symbol K]
+
+    cu {} {
+	compile_unit {
+	    {language @DW_LANG_Fortran90}
+	    {name dw2-entry-points.f90}
+	    {comp_dir /tmp}
+	} {
+	    int_label: base_type {
+		{name "int"}
+		{byte_size $int_size sdata}
+		{encoding @DW_ATE_signed}
+	    }
+	    subprogram {
+		{name prog}
+		{decl_file 1 data1}
+		{decl_line $prog_line data1}
+		{low_pc $main_start addr}
+		{high_pc "$main_start + $main_len" addr}
+		{external 1 flag}
+		{main_subprogram 1 flag}
+	    }
+	    subprogram {
+		{name bar}
+		{decl_file 1 data1}
+		{decl_line $bar_line data1}
+		{external 1 flag}
+		{low_pc $bar_helper_start addr}
+		{high_pc "$bar_helper_start + $bar_helper_len" addr}
+	    } {
+		formal_parameter {
+		    {name I}
+		    {type :$int_label}
+		    {location {addr $global_I} SPECIAL_expr}
+		}
+		formal_parameter {
+		    {name J}
+		    {type :$int_label}
+		    {location {addr $global_J} SPECIAL_expr}
+		}
+		entry_point {
+		    {name foo}
+		    {decl_file 1 data1}
+		    {decl_line $foo_line data1}
+		    {low_pc foo_entry_label addr}
+		} {
+		    formal_parameter {
+			{name J}
+			{type :$int_label}
+			{location {addr $global_J} SPECIAL_expr}
+		    }
+		    formal_parameter {
+			{name K}
+			{type :$int_label}
+			{location {addr $global_K} SPECIAL_expr}
+		    }
+		}
+		entry_point {
+			{name foobar}
+			{decl_file 1 data1}
+			{decl_line $foobar_line data1}
+			{low_pc foobar_entry_label addr}
+		    } {
+		    formal_parameter {
+			{name J}
+			{type :$int_label}
+			{location {addr $global_J} SPECIAL_expr}
+		    }
+		}
+	    }
+	}
+    }
+
+    cu {} {
+	compile_unit {
+	    {language @DW_LANG_Fortran90}
+	    {name dw2-entry-points-2.f90}
+	    {comp_dir /tmp}
+	} {
+	    int2_label: base_type {
+		{name "int"}
+		{byte_size $int_size sdata}
+		{encoding @DW_ATE_signed}
+	    }
+	    subprogram {
+		{name barso}
+		{decl_file 1 data1}
+		{decl_line $bar_line data1}
+		{external 1 flag}
+		{low_pc $bar_helper_start addr}
+		{high_pc "$bar_helper_start + $bar_helper_len" addr}
+	    } {
+		formal_parameter {
+		    {name I}
+		    {type :$int2_label}
+		    {location {addr $global_I} SPECIAL_expr}
+		}
+		formal_parameter {
+		    {name J}
+		    {type :$int2_label}
+		    {location {addr $global_J} SPECIAL_expr}
+		}
+		entry_point {
+		    {name fooso}
+		    {decl_file 1 data1}
+		    {decl_line $foo_line data1}
+		    {low_pc foo_entry_label addr}
+		} {
+		    formal_parameter {
+			{name J}
+			{type :$int2_label}
+			{location {addr $global_J} SPECIAL_expr}
+		    }
+		    formal_parameter {
+			{name K}
+			{type :$int2_label}
+			{location {addr $global_K} SPECIAL_expr}
+		    }
+		}
+	    }
+	}
+    }
+}
+
+if {[prepare_for_testing "failed to prepare" ${testfile} \
+	 [list $srcfile $asm_file] {nodebug}]} {
+    return -1
+}
+
+if ![runto_main] {
+    return -1
+}
+
+# Try whether we can set and hit breakpoints at the entry_points.
+gdb_breakpoint "foo"
+gdb_breakpoint "foobar"
+
+# Now hit the entry_point break point and check their call-stack.
+gdb_continue_to_breakpoint "foo"
+gdb_test "bt" [multi_line \
+		   "#0.*${hex} in foo \\(J=1, K=0\\).*" \
+		   "#1.*${hex} in prog \\(\\).*" \
+    ] "bt foo"
+
+gdb_continue_to_breakpoint "foobar"
+gdb_test "bt" [multi_line \
+		   "#0.*${hex} in foobar \\(J=2\\).*" \
+		   "#1.*${hex} in prog \\(\\).*" \
+    ] "bt foobar"
+
+# Now try whether we can also set breakpoints on entry_points from other CUs.
+
+clean_restart ${testfile}
+
+if ![runto_main] {
+    return -1
+}
+
+gdb_breakpoint "fooso"
+gdb_continue_to_breakpoint "foo_so"
+
+gdb_test "bt" [multi_line \
+		    "#0.*${hex} in foo \\(J=1, K=0\\).*" \
+		    "#1.*${hex} in prog \\(\\).*" \
+] "bt fooso"
diff --git a/gdb/testsuite/gdb.fortran/entry-point.exp b/gdb/testsuite/gdb.fortran/entry-point.exp
new file mode 100644
index 00000000000..679191f79f8
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/entry-point.exp
@@ -0,0 +1,84 @@
+# Copyright 2022 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/>.
+#
+# Test Fortran entry points for subroutines.
+
+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 { ![fortran_runto_main] } {
+    untested "could not run to main"
+    return -1
+}
+
+# Test if we can set a breakpoint via the entry-point name.
+set entry_point_name "foo"
+gdb_breakpoint $entry_point_name
+gdb_continue_to_breakpoint "continue to breakpoint: $entry_point_name" \
+    ".*entry foo\\(J,K,L,I1\\).*"
+
+gdb_test "print j" "= 11" "print j, entered via $entry_point_name"
+gdb_test "print k" "= 22" "print k, entered via $entry_point_name"
+gdb_test "print l" "= 33" "print l, entered via $entry_point_name"
+gdb_test "print i1" "= 44" "print i1, entered via $entry_point_name"
+gdb_test "info args" \
+    [multi_line "j = 11" \
+		"k = 22" \
+		"l = 33" \
+		"i1 = 44"] \
+    "info args, entered via $entry_point_name"
+
+# Test if we can set a breakpoint via the function name.
+set entry_point_name "bar"
+gdb_breakpoint $entry_point_name
+gdb_continue_to_breakpoint "continue to breakpoint: $entry_point_name" \
+    ".*subroutine bar\\(I,J,K,I1\\).*"
+
+gdb_test "print i" "= 444" "print i, entered via $entry_point_name"
+gdb_test "print j" "= 555" "print j, entered via $entry_point_name"
+gdb_test "print k" "= 666" "print k, entered via $entry_point_name"
+gdb_test "print i1" "= 777" "print i1, entered via $entry_point_name"
+
+# Test a second entry point.
+set entry_point_name "foobar"
+gdb_breakpoint $entry_point_name
+gdb_continue_to_breakpoint "continue to breakpoint: $entry_point_name" \
+    ".* entry foobar\\(J\\).*"
+
+gdb_test "print j" "= 1" "print j, entered via $entry_point_name"
+gdb_test "info args" "j = 1" "info args, entered via $entry_point_name"
+
+# Test breaking at the entrypoint defined inside the module mod via its
+# scoped name.
+set entry_point_name "mod::mod_foo"
+
+# GCC moves subroutines with entry points out of the module scope into the
+# compile unit scope.
+if {[test_compiler_info {gcc-*}]} {
+    setup_xfail "gcc/105272" *-*-*
+}
+gdb_breakpoint $entry_point_name
+
+if {[test_compiler_info {gcc-*}]} {
+    setup_xfail "gcc/105272" *-*-*
+}
+gdb_continue_to_breakpoint "continue to breakpoint: $entry_point_name" \
+    ".* entry mod_foo\\(\\).*"
diff --git a/gdb/testsuite/gdb.fortran/entry-point.f90 b/gdb/testsuite/gdb.fortran/entry-point.f90
new file mode 100644
index 00000000000..12a0557e787
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/entry-point.f90
@@ -0,0 +1,67 @@
+! Copyright 2022 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 mod
+implicit none
+
+contains
+  subroutine mod_bar
+    integer :: I = 3
+
+    goto 100
+
+    entry mod_foo
+    I = 33
+
+100 print *, I
+  end subroutine mod_bar
+end module mod
+
+
+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 300
+
+  entry foo(J,K,L,I1)
+  A = J + K + L + I1
+
+200 C = J
+  goto 300
+
+  entry foobar(J)
+  goto 200
+
+300 A = C + 1
+  C = J * 1.5
+
+  return
+end subroutine
+
+program TestEntryPoint
+  use mod
+
+  call foo(11,22,33,44)
+  call bar(444,555,666,777)
+  call foobar(1)
+
+  call mod_foo()
+end program TestEntryPoint
-- 
2.25.1

Intel Deutschland GmbH
Registered Address: Am Campeon 10, 85579 Neubiberg, Germany
Tel: +49 89 99 8853-0, www.intel.de <http://www.intel.de>
Managing Directors: Christin Eisenschmid, Sharon Heck, Tiffany Doon Silva  
Chairperson of the Supervisory Board: Nicole Lau
Registered Office: Munich
Commercial Register: Amtsgericht Muenchen HRB 186928

Re: [PATCH v4 3/3] dwarf, fortran: add support for DW_TAG_entry_point

[Tom Tromey]

>>>>> Nils-Christian Kempke via Gdb-patches <gdb-patches@sourceware.org> writes:

> Fortran provides additional entry points for subroutines and functions.
> These entry points may use only a subset (or a different set) of the
> parameters of the original subroutine.  The entry points may be described
> via the DWARF tag DW_TAG_entry_point.

> @@ -21797,12 +21852,15 @@ determine_prefix (struct die_info *die, struct dwarf2_cu *cu)
>  	return "";
>        case DW_TAG_subprogram:
>  	/* Nested subroutines in Fortran get a prefix with the name
> -	   of the parent's subroutine.  */
> +	   of the parent's subroutine.  Entry points are prefixed by the
> +	   parent's namespace.  */
>  	if (cu->lang () == language_fortran)
>  	  {
>  	    if ((die->tag ==  DW_TAG_subprogram)
>  		&& (dwarf2_name (parent, cu) != NULL))
>  	      return dwarf2_name (parent, cu);
> +	    else if (die->tag == DW_TAG_entry_point)
> +	      return determine_prefix (parent, cu);
>  	  }

It seems to me that this will also need a special case in
cooked_indexer::index_dies to ensure that the cooked_index_entry for the
entry point has the correct parent.  Parent relationships are how name
components are determined there, so IIUC the entry point's parent should
be the same as the subroutine's parent -- not the subroutine itself.

One way to see whether this works is to write a .gdb_index and then dump
it and examine the resulting name of the entry point.

thanks,
Tom

RE: [PATCH v4 3/3] dwarf, fortran: add support for DW_TAG_entry_point

[Kempke, Nils-Christian via Gdb-patches]

> -----Original Message-----
> From: Tom Tromey <tom@tromey.com>
> Sent: Friday, July 15, 2022 9:57 PM
> To: Nils-Christian Kempke via Gdb-patches <gdb-patches@sourceware.org>
> Cc: Kempke, Nils-Christian <nils-christian.kempke@intel.com>;
> aburgess@redhat.com; Tim Wiederhake <tim.wiederhake@intel.com>;
> Bernhard Heckel <bernhard.heckel@intel.com>;
> jinisusan.george@amd.com; tom@tromey.com
> Subject: Re: [PATCH v4 3/3] dwarf, fortran: add support for
> DW_TAG_entry_point
> 
> >>>>> Nils-Christian Kempke via Gdb-patches <gdb-
> patches@sourceware.org> writes:
> 
> > Fortran provides additional entry points for subroutines and functions.
> > These entry points may use only a subset (or a different set) of the
> > parameters of the original subroutine.  The entry points may be described
> > via the DWARF tag DW_TAG_entry_point.
> 
> > @@ -21797,12 +21852,15 @@ determine_prefix (struct die_info *die,
> struct dwarf2_cu *cu)
> >  	return "";
> >        case DW_TAG_subprogram:
> >  	/* Nested subroutines in Fortran get a prefix with the name
> > -	   of the parent's subroutine.  */
> > +	   of the parent's subroutine.  Entry points are prefixed by the
> > +	   parent's namespace.  */
> >  	if (cu->lang () == language_fortran)
> >  	  {
> >  	    if ((die->tag ==  DW_TAG_subprogram)
> >  		&& (dwarf2_name (parent, cu) != NULL))
> >  	      return dwarf2_name (parent, cu);
> > +	    else if (die->tag == DW_TAG_entry_point)
> > +	      return determine_prefix (parent, cu);
> >  	  }
> 
> It seems to me that this will also need a special case in
> cooked_indexer::index_dies to ensure that the cooked_index_entry for the
> entry point has the correct parent.  Parent relationships are how name
> components are determined there, so IIUC the entry point's parent should
> be the same as the subroutine's parent -- not the subroutine itself.
> 
> One way to see whether this works is to write a .gdb_index and then dump
> it and examine the resulting name of the entry point.
> 
> thanks,
> Tom

Hi Tom,

Thanks for the review - ah, I see. Let me quickly recap just to see whether I
understood this: when writing the gdb_index we use the
full_name (struct obstack *storage) method of the cooked_index_entry.

In order for the name scope to be correct we'd have to set the function's
parent as the entry's parent.

I changed this now to correctly set the cooked_index_entry's parent but,
I could not test this with my Fortran examples/code.  The problem is that
full_name (struct obstack *storage) does not consider the scope when
the language is set to Fortran - while I could verify that the parent is set
correctly and the name would be printed correctly if I hack the language if
a bit - with Fortran code (the currently only user of DW_TAG_entry_point
I know), full_name will return 'canonical' which is still the name of the
entry point without scope.

I will send a v5 shortly with the above mentioned change.

Thanks,
Nils
Intel Deutschland GmbH
Registered Address: Am Campeon 10, 85579 Neubiberg, Germany
Tel: +49 89 99 8853-0, www.intel.de <http://www.intel.de>
Managing Directors: Christin Eisenschmid, Sharon Heck, Tiffany Doon Silva  
Chairperson of the Supervisory Board: Nicole Lau
Registered Office: Munich
Commercial Register: Amtsgericht Muenchen HRB 186928