Merge branch 'topic/1084' into 'master'

Name resolution: do not call xref_no_overloading for resolving CallExprs

Closes #1084

See merge request eng/libadalang/libadalang!1419

ada/ast.py

@@ -20106,7 +20106,13 @@ def xref_equation():
 
             # Entry attributes (RM 9.9)
             rel_name == 'Count',
-            Entity.prefix.xref_no_overloading
+            Entity.prefix.match(
+                # If prefix is a CallExpr, use sub_equation to resolve the
+                # entry reference as it specifies a family member.
+                lambda ce=T.CallExpr: ce.sub_equation,
+                # On the other cases, prefix is a simple identifier
+                lambda o: o.xref_no_overloading
+            )
             & Self.universal_int_bind(Self.type_var),
 
             rel_name == 'Caller',
@@ -21634,10 +21640,16 @@ class SubpRenamingDecl(BaseSubpBody):
             # resolution to synthesize its corresponding function.
             Entity.renames.renamed_object.sub_equation,
 
-            Entity.renames.renamed_object.xref_no_overloading(all_els=True)
-            & Predicate(BasicDecl.subp_decl_match_signature,
-                        Entity.renames.renamed_object.ref_var,
-                        Entity.cast(T.BasicDecl))
+            Entity.renames.renamed_object.match(
+                # If renamed_object is a CallExpr, this is likely the renaming
+                # of an entry decl with a family member specified, so use
+                # sub_equation.
+                lambda ce=T.CallExpr: ce.sub_equation,
+                # On the other cases, prefix is a simple identifier
+                lambda o: o.xref_no_overloading(all_els=True)
+            ) & Predicate(BasicDecl.subp_decl_match_signature,
+                          Entity.renames.renamed_object.ref_var,
+                          Entity.cast(T.BasicDecl))
         ),
         # Operators might be built-in, so if we cannot find a reference, we'll
         # just abandon resolution...
@@ -21951,7 +21963,19 @@ def xref_equation():
         return And(
             # We call xref_no_overloading to make sure that sub-names are
             # bound.
-            name.xref_no_overloading,
+            name.match(
+                # If name is a DottedName, prefix can be a CallExpr that should
+                # be resolved using sub_equation.
+                lambda dn=T.DottedName:
+                If(dn.prefix.is_a(CallExpr),
+                   dn.prefix.sub_equation,
+                   dn.prefix.xref_no_overloading)
+                & env.bind(
+                    dn.prefix.designated_env,
+                    dn.suffix.xref_no_overloading
+                ),
+                lambda o: o.xref_no_overloading
+            ),
 
             # Then, bind the name to any entry that fits the bills
             entries.logic_any(lambda e: Let(

testsuite/tests/name_resolution/count_attr/test.adb

@@ -0,0 +1,44 @@
+-- This test ensures that 'Count attribute can resolve when used on an entry
+-- with a family memer.
+procedure Test is
+   type Enume is (X, Y, Z);
+
+   task T is
+      entry E (1 .. 4);
+      entry F (Enume);
+      entry G (Enume) (A, B : Float);
+   end T;
+
+   task body T is
+      I : Integer := E (3)'Count;
+      pragma Test_Statement;
+
+      J : Integer := F (X)'Count;
+      pragma Test_Statement;
+
+      K : Integer := G (Y)'Count;
+      pragma Test_Statement;
+   begin
+      null;
+   end T;
+
+   protected type PT is
+      entry E (X : Float);
+   end PT;
+
+   protected body PT is
+      function C return Integer is
+      begin
+         return E'Count;
+         pragma Test_Statement;
+         -- This is just a non-regression test
+      end C;
+
+      entry E (X : Float) when True is
+      begin
+         null;
+      end E;
+   end PT;
+begin
+   null;
+end Test;

testsuite/tests/name_resolution/count_attr/test.out

@@ -0,0 +1,105 @@
+Analyzing test.adb
+##################
+
+Resolving xrefs for node <ObjectDecl ["I"] test.adb:13:7-13:34>
+***************************************************************
+
+Expr: <Id "Integer" test.adb:13:11-13:18>
+  references:    <DefiningName "Integer" __standard:4:8-4:15>
+  type:          None
+  expected type: None
+Expr: <AttributeRef test.adb:13:22-13:33>
+  references:    None
+  type:          <ConcreteTypeDecl ["Universal_Int_Type_"] __standard:116:3-116:45>
+  expected type: <ConcreteTypeDecl ["Integer"] __standard:4:3-4:54>
+Expr: <CallExpr test.adb:13:22-13:27>
+  references:    <DefiningName "E" test.adb:7:13-7:14>
+  type:          None
+  expected type: None
+Expr: <Id "E" test.adb:13:22-13:23>
+  references:    <DefiningName "E" test.adb:7:13-7:14>
+  type:          None
+  expected type: None
+Expr: <Int test.adb:13:25-13:26>
+  references:    None
+  type:          <ConcreteTypeDecl ["Universal_Int_Type_"] __standard:116:3-116:45>
+  expected type: None
+Expr: <Id "Count" test.adb:13:28-13:33>
+  references:    None
+  type:          None
+  expected type: None
+
+Resolving xrefs for node <ObjectDecl ["J"] test.adb:16:7-16:34>
+***************************************************************
+
+Expr: <Id "Integer" test.adb:16:11-16:18>
+  references:    <DefiningName "Integer" __standard:4:8-4:15>
+  type:          None
+  expected type: None
+Expr: <AttributeRef test.adb:16:22-16:33>
+  references:    None
+  type:          <ConcreteTypeDecl ["Universal_Int_Type_"] __standard:116:3-116:45>
+  expected type: <ConcreteTypeDecl ["Integer"] __standard:4:3-4:54>
+Expr: <CallExpr test.adb:16:22-16:27>
+  references:    <DefiningName "F" test.adb:8:13-8:14>
+  type:          None
+  expected type: None
+Expr: <Id "F" test.adb:16:22-16:23>
+  references:    <DefiningName "F" test.adb:8:13-8:14>
+  type:          None
+  expected type: None
+Expr: <Id "X" test.adb:16:25-16:26>
+  references:    <DefiningName "X" test.adb:4:19-4:20>
+  type:          <ConcreteTypeDecl ["Enume"] test.adb:4:4-4:28>
+  expected type: <ConcreteTypeDecl ["Enume"] test.adb:4:4-4:28>
+Expr: <Id "Count" test.adb:16:28-16:33>
+  references:    None
+  type:          None
+  expected type: None
+
+Resolving xrefs for node <ObjectDecl ["K"] test.adb:19:7-19:34>
+***************************************************************
+
+Expr: <Id "Integer" test.adb:19:11-19:18>
+  references:    <DefiningName "Integer" __standard:4:8-4:15>
+  type:          None
+  expected type: None
+Expr: <AttributeRef test.adb:19:22-19:33>
+  references:    None
+  type:          <ConcreteTypeDecl ["Universal_Int_Type_"] __standard:116:3-116:45>
+  expected type: <ConcreteTypeDecl ["Integer"] __standard:4:3-4:54>
+Expr: <CallExpr test.adb:19:22-19:27>
+  references:    <DefiningName "G" test.adb:9:13-9:14>
+  type:          None
+  expected type: None
+Expr: <Id "G" test.adb:19:22-19:23>
+  references:    <DefiningName "G" test.adb:9:13-9:14>
+  type:          None
+  expected type: None
+Expr: <Id "Y" test.adb:19:25-19:26>
+  references:    <DefiningName "Y" test.adb:4:22-4:23>
+  type:          <ConcreteTypeDecl ["Enume"] test.adb:4:4-4:28>
+  expected type: <ConcreteTypeDecl ["Enume"] test.adb:4:4-4:28>
+Expr: <Id "Count" test.adb:19:28-19:33>
+  references:    None
+  type:          None
+  expected type: None
+
+Resolving xrefs for node <ReturnStmt test.adb:32:10-32:25>
+**********************************************************
+
+Expr: <AttributeRef test.adb:32:17-32:24>
+  references:    None
+  type:          <ConcreteTypeDecl ["Universal_Int_Type_"] __standard:116:3-116:45>
+  expected type: <ConcreteTypeDecl ["Integer"] __standard:4:3-4:54>
+Expr: <Id "E" test.adb:32:17-32:18>
+  references:    <DefiningName "E" test.adb:26:13-26:14>
+  type:          None
+  expected type: None
+Expr: <Id "Count" test.adb:32:19-32:24>
+  references:    None
+  type:          None
+  expected type: None
+
+
+Done.

testsuite/tests/name_resolution/count_attr/test.yaml

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

testsuite/tests/name_resolution/entry_renaming/family.adb

@@ -0,0 +1,21 @@
+procedure Family is
+   type Enume is (X, Y, Z);
+
+   task T is
+      entry E (1 .. 4);
+      entry F (Enume);
+   end T;
+
+   task body T is
+   begin
+      null;
+   end T;
+
+   procedure P renames T.E (2);
+   pragma Test_Statement;
+
+   procedure P renames T.F (Z);
+   pragma Test_Statement;
+begin
+   null;
+end Family;

testsuite/tests/name_resolution/entry_renaming/test.out

@@ -50,4 +50,56 @@ Expr: <Id "Ent" test.adb:27:8-27:11>
   expected type: None
 
 
+Analyzing family.adb
+####################
+
+Resolving xrefs for node <SubpRenamingDecl ["P"] family.adb:14:4-14:32>
+***********************************************************************
+
+Expr: <CallExpr family.adb:14:24-14:31>
+  references:    <DefiningName "E" family.adb:5:13-5:14>
+  type:          None
+  expected type: None
+Expr: <DottedName family.adb:14:24-14:27>
+  references:    <DefiningName "E" family.adb:5:13-5:14>
+  type:          None
+  expected type: None
+Expr: <Id "T" family.adb:14:24-14:25>
+  references:    <DefiningName "T" family.adb:4:9-4:10>
+  type:          <SingleTaskTypeDecl ["T"] family.adb:4:9-7:9>
+  expected type: None
+Expr: <Id "E" family.adb:14:26-14:27>
+  references:    <DefiningName "E" family.adb:5:13-5:14>
+  type:          None
+  expected type: None
+Expr: <Int family.adb:14:29-14:30>
+  references:    None
+  type:          <ConcreteTypeDecl ["Universal_Int_Type_"] __standard:116:3-116:45>
+  expected type: None
+
+Resolving xrefs for node <SubpRenamingDecl ["P"] family.adb:17:4-17:32>
+***********************************************************************
+
+Expr: <CallExpr family.adb:17:24-17:31>
+  references:    <DefiningName "F" family.adb:6:13-6:14>
+  type:          None
+  expected type: None
+Expr: <DottedName family.adb:17:24-17:27>
+  references:    <DefiningName "F" family.adb:6:13-6:14>
+  type:          None
+  expected type: None
+Expr: <Id "T" family.adb:17:24-17:25>
+  references:    <DefiningName "T" family.adb:4:9-4:10>
+  type:          <SingleTaskTypeDecl ["T"] family.adb:4:9-7:9>
+  expected type: None
+Expr: <Id "F" family.adb:17:26-17:27>
+  references:    <DefiningName "F" family.adb:6:13-6:14>
+  type:          None
+  expected type: None
+Expr: <Id "Z" family.adb:17:29-17:30>
+  references:    <DefiningName "Z" family.adb:2:25-2:26>
+  type:          <ConcreteTypeDecl ["Enume"] family.adb:2:4-2:28>
+  expected type: <ConcreteTypeDecl ["Enume"] family.adb:2:4-2:28>
+
+
 Done.

testsuite/tests/name_resolution/entry_renaming/test.yaml

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

testsuite/tests/name_resolution/requeue_stmt_3/test.adb

@@ -0,0 +1,39 @@
+procedure Test is
+   protected type PT is
+      entry Process;
+   end PT;
+
+   protected body PT is
+      entry Process when True is
+      begin
+         null;
+      end Process;
+   end PT;
+
+   type My_Range is range 1 .. 2;
+   type My_Array is array (My_Range) of PT;
+   Arr : My_Array;
+
+   function F (I, J : Float) return My_Range is
+   begin
+      return My_Range (I * J);
+   end F;
+
+   task T is
+      entry P (Name : String);
+   end T;
+
+   task body T is
+      Index : My_Range := 1;
+   begin
+      accept P (Name : String) do
+         requeue Arr (Index).Process;
+         pragma Test_Statement;
+
+         requeue Arr (F (4.3, 8.9)).Process;
+         pragma Test_Statement;
+      end P;
+   end T;
+begin
+   null;
+end Test;

testsuite/tests/name_resolution/requeue_stmt_3/test.out

@@ -0,0 +1,65 @@
+Analyzing test.adb
+##################
+
+Resolving xrefs for node <RequeueStmt test.adb:30:10-30:38>
+***********************************************************
+
+Expr: <DottedName test.adb:30:18-30:37>
+  references:    <DefiningName "Process" test.adb:3:13-3:20>
+  type:          None
+  expected type: None
+Expr: <CallExpr test.adb:30:18-30:29>
+  references:    <DefiningName "Arr" test.adb:15:4-15:7>
+  type:          <ProtectedTypeDecl ["PT"] test.adb:2:4-4:11>
+  expected type: None
+Expr: <Id "Arr" test.adb:30:18-30:21>
+  references:    <DefiningName "Arr" test.adb:15:4-15:7>
+  type:          <ConcreteTypeDecl ["My_Array"] test.adb:14:4-14:44>
+  expected type: None
+Expr: <Id "Index" test.adb:30:23-30:28>
+  references:    <DefiningName "Index" test.adb:27:7-27:12>
+  type:          <ConcreteTypeDecl ["My_Range"] test.adb:13:4-13:34>
+  expected type: <ConcreteTypeDecl ["My_Range"] test.adb:13:4-13:34>
+Expr: <Id "Process" test.adb:30:30-30:37>
+  references:    <DefiningName "Process" test.adb:3:13-3:20>
+  type:          None
+  expected type: None
+
+Resolving xrefs for node <RequeueStmt test.adb:33:10-33:45>
+***********************************************************
+
+Expr: <DottedName test.adb:33:18-33:44>
+  references:    <DefiningName "Process" test.adb:3:13-3:20>
+  type:          None
+  expected type: None
+Expr: <CallExpr test.adb:33:18-33:36>
+  references:    <DefiningName "Arr" test.adb:15:4-15:7>
+  type:          <ProtectedTypeDecl ["PT"] test.adb:2:4-4:11>
+  expected type: None
+Expr: <Id "Arr" test.adb:33:18-33:21>
+  references:    <DefiningName "Arr" test.adb:15:4-15:7>
+  type:          <ConcreteTypeDecl ["My_Array"] test.adb:14:4-14:44>
+  expected type: None
+Expr: <CallExpr test.adb:33:23-33:35>
+  references:    <DefiningName "F" test.adb:17:13-17:14>
+  type:          <ConcreteTypeDecl ["My_Range"] test.adb:13:4-13:34>
+  expected type: <ConcreteTypeDecl ["My_Range"] test.adb:13:4-13:34>
+Expr: <Id "F" test.adb:33:23-33:24>
+  references:    <DefiningName "F" test.adb:17:13-17:14>
+  type:          <ConcreteTypeDecl ["My_Range"] test.adb:13:4-13:34>
+  expected type: None
+Expr: <Real test.adb:33:26-33:29>
+  references:    None
+  type:          <ConcreteTypeDecl ["Universal_Real_Type_"] __standard:117:3-117:42>
+  expected type: <ConcreteTypeDecl ["Float"] __standard:14:3-15:51>
+Expr: <Real test.adb:33:31-33:34>
+  references:    None
+  type:          <ConcreteTypeDecl ["Universal_Real_Type_"] __standard:117:3-117:42>
+  expected type: <ConcreteTypeDecl ["Float"] __standard:14:3-15:51>
+Expr: <Id "Process" test.adb:33:37-33:44>
+  references:    <DefiningName "Process" test.adb:3:13-3:20>
+  type:          None
+  expected type: None
+
+
+Done.