Merge branch 'topic/1082' into 'master'

Better support of Entry Calls name resolution

Closes #1082

See merge request eng/libadalang/libadalang!1418

ada/ast.py

@@ -18080,9 +18080,10 @@ def env_elements_baseid():
                 )
             ),
 
-            # This identifier is the name for a called subprogram or an array.
+            # This identifier is the name for a called subprogram, entry, or an
+            # array.
             # So only keep:
-            # * subprograms for which the actuals match
+            # * subprograms/entries for which the actuals match
             # * arrays for which the number of dimensions match
             # * any type that has a user defined indexing aspect.
 
@@ -18093,35 +18094,9 @@ def env_elements_baseid():
 
                     lambda b=BasicDecl:
                     b.subp_spec_or_null.then(
-                        lambda spec: Let(
-                            lambda real_pc=If(
-                                spec.cast(T.EntrySpec)._.family_type.is_null,
-                                pc, pc.parent.cast(T.CallExpr)
-                            ):
-                            # ``real_pc`` can be null if we are handling a
-                            # paramless entry decl that has an entry family,
-                            # in which case the subsequent checks are not
-                            # relevant.
-                            real_pc.is_null
-
-                            # Either the subprogram is matching the CallExpr's
-                            # parameters.
-                            | And(
-                                spec.is_matching_param_list(
-                                    params, b.info.md.dottable_subp
-                                ),
-                                real_pc.parent.cast(T.CallExpr).then(
-                                    lambda ce: ce.check_for_type(b.expr_type),
-                                    default_val=True
-                                )
-                            )
-
-                            # Or the entity is parameterless, and the returned
-                            # component (s) matches the callexpr (s).
-                            | And(real_pc.check_for_type(b.expr_type),
-                                  spec.paramless(b.info.md.dottable_subp)),
+                        lambda spec:
+                        Entity.call_matches_spec(spec, pc, params, b),
 
-                        ),
                         # In the case of ObjectDecls/CompDecls in general,
                         # verify that the callexpr is valid for the given
                         # type designator.
@@ -18137,6 +18112,56 @@ def env_elements_baseid():
             )
         ))
 
+    @langkit_property(dynamic_vars=[env, origin], return_type=T.Bool)
+    def call_matches_spec(spec=T.BaseSubpSpec.entity, pc=T.CallExpr.entity,
+                          params=T.AssocList.entity, b=T.BasicDecl.entity):
+        """
+        Return whether the BasicDecl ``b`` should be kept during
+        ``env_elements_baseid`` items filtering. This piece of code has been
+        extracted from ``env_elements_baseid`` to improve code readability.
+        """
+        family_type = Var(spec.cast(T.EntrySpec)._.family_type)
+
+        # If b is a `EntryDecl` with a specified family type, then the real
+        # `CallExpr` is its parent, as in: `Task.Entry (Family) (Arg1, Arg2)`,
+        # where `Entry (Family) (Arg1, Arg2)` is the real `CallExpr`, not just
+        # `Entry (Family)`. Adjust `pc` and `params` accordingly:
+        real_pc = Var(If(
+            family_type.is_null,
+            pc, pc.parent.cast(T.CallExpr)
+        ))
+        real_params = Var(If(
+            family_type.is_null,
+            params, pc.parent.cast(T.CallExpr).then(
+                lambda ce:
+                ce.suffix.cast_or_raise(AssocList)
+            )
+        ))
+
+        return (
+            # ``real_pc`` can be null if we are handling a paramless entry decl
+            # that has an entry family, in which case the subsequent checks are
+            # not relevant.
+            real_pc.is_null
+
+            # Either the subprogram/entry is matching the CallExpr's parameters
+            | And(
+                spec.is_matching_param_list(
+                    real_params, b.info.md.dottable_subp
+                ),
+                real_pc.parent.cast(T.CallExpr).then(
+                    lambda ce:
+                    ce.check_for_type(b.expr_type),
+                    default_val=True
+                )
+            )
+
+            # Or the entity is parameterless, and the returned component (s)
+            # matches the callexpr (s).
+            | And(real_pc.check_for_type(b.expr_type),
+                  spec.paramless(b.info.md.dottable_subp))
+        )
+
     @langkit_property(return_type=Bool)
     def denotes_the_property_function(subp_spec=T.BaseSubpSpec.entity):
         # Return true whether this node can refer to a property function

testsuite/tests/name_resolution/entry_families_3/test.adb

@@ -0,0 +1,38 @@
+procedure Test is
+
+   type Enume is (S, P, A, R, K);
+
+   task type TT is
+      entry F (1 .. 3) (I : Integer; J : out Integer);
+      entry G (Enume) (I : Integer; J : out Integer);
+   end TT;
+
+   type Parent is access TT;
+   type T is new Parent;
+
+   X : T;
+   I : Integer := 0;
+   J : Integer := 0;
+
+   task body TT is
+      N : Integer := 1;
+   begin
+      loop
+         select
+            accept F (2) (I : Integer; J : out Integer) do
+               j := i + n;
+            end F;
+         or
+            terminate;
+         end select;
+      end loop;
+   end TT;
+begin
+     X := new TT;
+
+     X.F (2) (I, J);
+     pragma Test_Statement;
+
+     X.G (R) (I, J);
+     pragma Test_Statement;
+end Test;

testsuite/tests/name_resolution/entry_families_3/test.out

@@ -0,0 +1,77 @@
+Analyzing test.adb
+##################
+
+Resolving xrefs for node <CallStmt test.adb:33:6-33:21>
+*******************************************************
+
+Expr: <CallExpr test.adb:33:6-33:20>
+  references:    <DefiningName "F" test.adb:6:13-6:14>
+  type:          None
+  expected type: None
+Expr: <CallExpr test.adb:33:6-33:13>
+  references:    <DefiningName "F" test.adb:6:13-6:14>
+  type:          None
+  expected type: None
+Expr: <DottedName test.adb:33:6-33:9>
+  references:    <DefiningName "F" test.adb:6:13-6:14>
+  type:          None
+  expected type: None
+Expr: <Id "X" test.adb:33:6-33:7>
+  references:    <DefiningName "X" test.adb:13:4-13:5>
+  type:          <ConcreteTypeDecl ["T"] test.adb:11:4-11:25>
+  expected type: None
+Expr: <Id "F" test.adb:33:8-33:9>
+  references:    <DefiningName "F" test.adb:6:13-6:14>
+  type:          None
+  expected type: None
+Expr: <Int test.adb:33:11-33:12>
+  references:    None
+  type:          <ConcreteTypeDecl ["Universal_Int_Type_"] __standard:116:3-116:45>
+  expected type: None
+Expr: <Id "I" test.adb:33:15-33:16>
+  references:    <DefiningName "I" test.adb:14:4-14:5>
+  type:          <ConcreteTypeDecl ["Integer"] __standard:4:3-4:54>
+  expected type: <ConcreteTypeDecl ["Integer"] __standard:4:3-4:54>
+Expr: <Id "J" test.adb:33:18-33:19>
+  references:    <DefiningName "J" test.adb:15:4-15:5>
+  type:          <ConcreteTypeDecl ["Integer"] __standard:4:3-4:54>
+  expected type: <ConcreteTypeDecl ["Integer"] __standard:4:3-4:54>
+
+Resolving xrefs for node <CallStmt test.adb:36:6-36:21>
+*******************************************************
+
+Expr: <CallExpr test.adb:36:6-36:20>
+  references:    <DefiningName "G" test.adb:7:13-7:14>
+  type:          None
+  expected type: None
+Expr: <CallExpr test.adb:36:6-36:13>
+  references:    <DefiningName "G" test.adb:7:13-7:14>
+  type:          None
+  expected type: None
+Expr: <DottedName test.adb:36:6-36:9>
+  references:    <DefiningName "G" test.adb:7:13-7:14>
+  type:          None
+  expected type: None
+Expr: <Id "X" test.adb:36:6-36:7>
+  references:    <DefiningName "X" test.adb:13:4-13:5>
+  type:          <ConcreteTypeDecl ["T"] test.adb:11:4-11:25>
+  expected type: None
+Expr: <Id "G" test.adb:36:8-36:9>
+  references:    <DefiningName "G" test.adb:7:13-7:14>
+  type:          None
+  expected type: None
+Expr: <Id "R" test.adb:36:11-36:12>
+  references:    <DefiningName "R" test.adb:3:28-3:29>
+  type:          <ConcreteTypeDecl ["Enume"] test.adb:3:4-3:34>
+  expected type: <ConcreteTypeDecl ["Enume"] test.adb:3:4-3:34>
+Expr: <Id "I" test.adb:36:15-36:16>
+  references:    <DefiningName "I" test.adb:14:4-14:5>
+  type:          <ConcreteTypeDecl ["Integer"] __standard:4:3-4:54>
+  expected type: <ConcreteTypeDecl ["Integer"] __standard:4:3-4:54>
+Expr: <Id "J" test.adb:36:18-36:19>
+  references:    <DefiningName "J" test.adb:15:4-15:5>
+  type:          <ConcreteTypeDecl ["Integer"] __standard:4:3-4:54>
+  expected type: <ConcreteTypeDecl ["Integer"] __standard:4:3-4:54>
+
+
+Done.

testsuite/tests/name_resolution/entry_families_3/test.yaml

@@ -0,0 +1,2 @@
+driver: name-resolution
+input_sources: [test.adb]