Merge branch 'topic/1243' into 'master'

gnat_xref: handle more cases for ParamSpec references

Closes #1243

See merge request eng/libadalang/libadalang!1522

ada/ast.py

@@ -1634,20 +1634,20 @@ def gnat_xref():
                  .then(lambda dn: dn.basic_decl))
 
         return origin.bind(Self, Cond(
-            bd.then(lambda bd: bd.is_a(T.ParamSpec))
-            & bd.semantic_parent.is_a(T.SubpDecl, T.ExprFunction,
-                                      T.GenericSubpInternal,
-                                      T.BaseTypeDecl),
+            bd._.is_a(T.ParamSpec)
+            & Or(
+                bd.semantic_parent.is_a(T.BasicSubpDecl, T.ExprFunction,
+                                        T.BaseTypeDecl, T.SubpBodyStub,
+                                        T.NullSubpDecl),
+                bd.semantic_parent.cast(T.SubpBody).then(
+                    lambda body: body.previous_part_for_decl.is_null
+                )
+            ),
             bd.semantic_parent.cast(T.BasicDecl).defining_name,
 
             bd.then(lambda bd: bd.is_a(T.DiscriminantSpec)),
             bd.semantic_parent.cast(T.BasicDecl).defining_name,
 
-            bd.then(lambda bd: bd.is_a(T.ParamSpec))
-            & bd.semantic_parent.is_a(T.AbstractSubpDecl, T.FormalSubpDecl,
-                                      T.NullSubpDecl),
-            bd.semantic_parent.cast(T.BasicDecl).defining_name,
-
             bd.then(lambda bd: bd.is_a(T.AbstractSubpDecl)),
             bd.cast(T.AbstractSubpDecl).subp_decl_spec
             .primitive_subp_first_type.defining_name,

testsuite/tests/name_resolution/gnat_compare_body_subprogram_parameters/prj.gpr

@@ -0,0 +1,4 @@
+project Prj is
+  for Source_Dirs use (".");
+  for Main use ("test.adb");
+end Prj;

testsuite/tests/name_resolution/gnat_compare_body_subprogram_parameters/test.adb

@@ -0,0 +1,13 @@
+procedure Test is
+   function F
+     (I : in     Integer;
+      J : in out Integer;
+      K : out    Integer;
+      L : access Integer) return Integer is
+   begin
+      return 0;
+   end F;
+   --  I, J, K, L references to F should be ignored by gnat_compare
+begin
+   null;
+end;

testsuite/tests/name_resolution/gnat_compare_body_subprogram_parameters/test.out

@@ -0,0 +1,17 @@
+== test.adb ==
+test.adb:1:11 => test.adb:1:11 (LAL: ok)
+test.adb:2:13 => test.adb:2:13 (LAL: ok)
+test.adb:3:7 => test.adb:2:13 (LAL: ok)
+test.adb:4:7 => test.adb:2:13 (LAL: ok)
+test.adb:5:7 => test.adb:2:13 (LAL: ok)
+test.adb:6:7 => test.adb:2:13 (LAL: ok)
+test.adb:9:8 => test.adb:2:13 (LAL: ok)
+
+Stats:
+GNAT xrefs have 7 entries
+LAL xrefs have:
+  * 7 OK entries (100.00%)
+  * 0 DIFFERENT entries (0.00%)
+  * 0 ERROR entries (0.00%)
+  * 0 MISSING entries (0.00%)
+  * 0 ADDITIONAL entries (0.00%)

testsuite/tests/name_resolution/gnat_compare_body_subprogram_parameters/test.yaml

@@ -0,0 +1,2 @@
+driver: gnat-compare
+project_file: prj.gpr