From 813ad6da6a1ed6128df4e8e9559115a515f021d9 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Laurent=20Th=C3=A9venoux?= <thevenoux@adacore.com>
Date: Tue, 30 Jan 2024 11:22:46 +0100
Subject: [PATCH] Handle SubpBody's DefiningName self reference in P_Gnat_Xref

When resolving a subprogram body, the subprogram body's name xrefs
contain a reference to itself. This patch adds that case to
`P_Gnat_Xref` in order to mimic GNAT's behavior.
---
 ada/ast.py                                          |  3 +++
 testsuite/tests/name_resolution/gnat_xref_1/prj.gpr |  4 ++++
 .../tests/name_resolution/gnat_xref_1/test.adb      |  4 ++++
 .../tests/name_resolution/gnat_xref_1/test.out      | 13 +++++++++++++
 .../tests/name_resolution/gnat_xref_1/test.yaml     |  2 ++
 5 files changed, 26 insertions(+)
 create mode 100644 testsuite/tests/name_resolution/gnat_xref_1/prj.gpr
 create mode 100644 testsuite/tests/name_resolution/gnat_xref_1/test.adb
 create mode 100644 testsuite/tests/name_resolution/gnat_xref_1/test.out
 create mode 100644 testsuite/tests/name_resolution/gnat_xref_1/test.yaml

diff --git a/ada/ast.py b/ada/ast.py
index 62070bcda..400281b0c 100644
--- a/ada/ast.py
+++ b/ada/ast.py
@@ -1663,6 +1663,9 @@ def gnat_xref():
                 )
             ),
 
+            bd.then(lambda bd: bd.is_a(T.BaseSubpBody)),
+            bd.cast(T.BaseSubpBody).subp_spec.subp_name,
+
             Entity.cast(T.Name)._.gnat_xref_decl.then(
                 lambda ret:
                 Let(lambda dbd=ret.basic_decl: Cond(
diff --git a/testsuite/tests/name_resolution/gnat_xref_1/prj.gpr b/testsuite/tests/name_resolution/gnat_xref_1/prj.gpr
new file mode 100644
index 000000000..4b29ca3fd
--- /dev/null
+++ b/testsuite/tests/name_resolution/gnat_xref_1/prj.gpr
@@ -0,0 +1,4 @@
+project Prj is
+  for Source_Dirs use (".");
+  for Main use ("test.adb");
+end Prj;
diff --git a/testsuite/tests/name_resolution/gnat_xref_1/test.adb b/testsuite/tests/name_resolution/gnat_xref_1/test.adb
new file mode 100644
index 000000000..0b7f4d3db
--- /dev/null
+++ b/testsuite/tests/name_resolution/gnat_xref_1/test.adb
@@ -0,0 +1,4 @@
+procedure P is
+begin
+   null;
+end P;
diff --git a/testsuite/tests/name_resolution/gnat_xref_1/test.out b/testsuite/tests/name_resolution/gnat_xref_1/test.out
new file mode 100644
index 000000000..59eb725e0
--- /dev/null
+++ b/testsuite/tests/name_resolution/gnat_xref_1/test.out
@@ -0,0 +1,13 @@
+test.adb:1:11: warning: file name does not match unit name, should be "p.adb" [enabled by default]
+== test.adb ==
+test.adb:1:11 => test.adb:1:11 (LAL: ok)
+test.adb:4:5 => test.adb:1:11 (LAL: ok)
+
+Stats:
+GNAT xrefs have 2 entries
+LAL xrefs have:
+  * 2 OK entries (100.00%)
+  * 0 DIFFERENT entries (0.00%)
+  * 0 ERROR entries (0.00%)
+  * 0 MISSING entries (0.00%)
+  * 0 ADDITIONAL entries (0.00%)
diff --git a/testsuite/tests/name_resolution/gnat_xref_1/test.yaml b/testsuite/tests/name_resolution/gnat_xref_1/test.yaml
new file mode 100644
index 000000000..9efa742f3
--- /dev/null
+++ b/testsuite/tests/name_resolution/gnat_xref_1/test.yaml
@@ -0,0 +1,2 @@
+driver: gnat-compare
+project_file: prj.gpr