From 1a36647c100bbbbfcc54d4c503f5d234a67eae5c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Laurent=20Th=C3=A9venoux?= <thevenoux@adacore.com>
Date: Tue, 30 Jan 2024 13:16:21 +0100
Subject: [PATCH] gnat_compare: skip 'E' xrefs (reference to first private
 entity)

When comparing GNAT's xrefs with libadalang nameres, skip references
to the first private entity.
---
 testsuite/ada/gnat_compare/xrefs.adb                |  9 +++++++--
 .../tests/name_resolution/gnat_compare_2/prj.gpr    |  4 ++++
 .../tests/name_resolution/gnat_compare_2/test.adb   |  8 ++++++++
 .../tests/name_resolution/gnat_compare_2/test.out   | 13 +++++++++++++
 .../tests/name_resolution/gnat_compare_2/test.yaml  |  2 ++
 5 files changed, 34 insertions(+), 2 deletions(-)
 create mode 100644 testsuite/tests/name_resolution/gnat_compare_2/prj.gpr
 create mode 100644 testsuite/tests/name_resolution/gnat_compare_2/test.adb
 create mode 100644 testsuite/tests/name_resolution/gnat_compare_2/test.out
 create mode 100644 testsuite/tests/name_resolution/gnat_compare_2/test.yaml

diff --git a/testsuite/ada/gnat_compare/xrefs.adb b/testsuite/ada/gnat_compare/xrefs.adb
index 1b8ee5c10..0bf8f0d91 100644
--- a/testsuite/ada/gnat_compare/xrefs.adb
+++ b/testsuite/ada/gnat_compare/xrefs.adb
@@ -213,10 +213,15 @@ package body Xrefs is
             raise Program_Error;
          end if;
 
-         --  Ignore "end of spec/body" xrefs, which point on the ending
+         --  Ignore "end of spec/body" xrefs (e/t), which point on the ending
          --  semicolon of an entity body. LAL won't support that.
+         --
+         --  Ignore "first private entity" (E) xref, which points on the first
+         --  private entity of a given package.
 
-         if Current_Xrefs /= null and then Type_Char not in 'e' | 't' then
+         if Current_Xrefs /= null
+         and then Type_Char not in 'e' | 't' | 'E'
+         then
             Current_Xrefs.Xrefs.Append
               (Xref_Type'(Ref_Sloc => (Line_Number (Line),
                                        Column_Number (Column)),
diff --git a/testsuite/tests/name_resolution/gnat_compare_2/prj.gpr b/testsuite/tests/name_resolution/gnat_compare_2/prj.gpr
new file mode 100644
index 000000000..4b29ca3fd
--- /dev/null
+++ b/testsuite/tests/name_resolution/gnat_compare_2/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_compare_2/test.adb b/testsuite/tests/name_resolution/gnat_compare_2/test.adb
new file mode 100644
index 000000000..f6d4ebdfe
--- /dev/null
+++ b/testsuite/tests/name_resolution/gnat_compare_2/test.adb
@@ -0,0 +1,8 @@
+procedure Test is
+   package P is
+   private
+      type I is new Integer;
+   end P;
+begin
+   null;
+end Test;
diff --git a/testsuite/tests/name_resolution/gnat_compare_2/test.out b/testsuite/tests/name_resolution/gnat_compare_2/test.out
new file mode 100644
index 000000000..2c1348866
--- /dev/null
+++ b/testsuite/tests/name_resolution/gnat_compare_2/test.out
@@ -0,0 +1,13 @@
+== test.adb ==
+test.adb:1:11 => test.adb:1:11 (LAL: ok)
+test.adb:5:8 => test.adb:2:12 (LAL: ok)
+test.adb:8:5 => test.adb:1:11 (LAL: ok)
+
+Stats:
+GNAT xrefs have 3 entries
+LAL xrefs have:
+  * 3 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_compare_2/test.yaml b/testsuite/tests/name_resolution/gnat_compare_2/test.yaml
new file mode 100644
index 000000000..9efa742f3
--- /dev/null
+++ b/testsuite/tests/name_resolution/gnat_compare_2/test.yaml
@@ -0,0 +1,2 @@
+driver: gnat-compare
+project_file: prj.gpr