Merge branch 'topic/constrain_prefix_subp_body' into 'master'

Share implementation of constrain prefix amongst all subps

Closes AdaCore#953

See merge request eng/libadalang/libadalang!1276

ada/ast.py

@@ -1874,6 +1874,25 @@ class BasicDecl(AdaNode):
     associates a name with a language entity, for example a type or a variable.
     """
 
+    @langkit_property(return_type=Equation, dynamic_vars=[origin])
+    def subp_constrain_prefix(prefix=T.Expr):
+        """
+        Implementation for ``BasicDecl.constrain_prefix`` but for subprograms.
+
+        Since subprograms can't have a base class, this is shared here.
+        """
+        return If(
+            # If self is a dottable subprogram, then we want to constrain the
+            # prefix so that it's type is the type of the first parameter of
+            # self.
+            Entity.info.md.dottable_subp,
+            Bind(prefix.expected_type_var,
+                 Entity.subp_spec_or_null
+                 .unpacked_formal_params.at(0)._.formal_decl.formal_type)
+            & prefix.matches_expected_prefix_type,
+            LogicTrue()
+        )
+
     @langkit_property()
     def env_hook_basic_decl():
         """
@@ -9771,17 +9790,7 @@ def next_part_for_decl():
 
     @langkit_property()
     def constrain_prefix(prefix=T.Expr):
-        return If(
-            # If self is a dottable subprogram, then we want to constrain the
-            # prefix so that it's type is the type of the first parameter of
-            # self.
-            Entity.info.md.dottable_subp,
-            Bind(prefix.expected_type_var,
-                 Entity.subp_decl_spec
-                 .unpacked_formal_params.at(0)._.formal_decl.formal_type)
-            & prefix.matches_expected_prefix_type,
-            LogicTrue()
-        )
+        return Entity.subp_constrain_prefix(prefix)
 
     @langkit_property()
     def expr_type():
@@ -20129,6 +20138,10 @@ class BaseSubpBody(Body):
 
     defining_names = Property(Entity.subp_spec.name.singleton)
 
+    @langkit_property()
+    def constrain_prefix(prefix=T.Expr):
+        return Entity.subp_constrain_prefix(prefix)
+
     @langkit_property()
     def defining_env():
         return If(

testsuite/tests/name_resolution/chained_dot_calls/test.out

@@ -18,131 +18,131 @@ Expr: <DottedName test.adb:12:8-47:15>
 Expr: <DottedName test.adb:12:8-46:17>
   references:    <DefiningName "New_Line" test.adb:6:16-6:24>
   type:          <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
-  expected type: None
+  expected type: <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
 Expr: <CallExpr test.adb:12:8-45:21>
   references:    <DefiningName "Append" test.adb:5:16-5:22>
   type:          <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
-  expected type: None
+  expected type: <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
 Expr: <DottedName test.adb:12:8-45:15>
   references:    <DefiningName "Append" test.adb:5:16-5:22>
   type:          <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
   expected type: None
 Expr: <DottedName test.adb:12:8-44:17>
   references:    <DefiningName "New_Line" test.adb:6:16-6:24>
   type:          <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
-  expected type: None
+  expected type: <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
 Expr: <CallExpr test.adb:12:8-43:21>
   references:    <DefiningName "Append" test.adb:5:16-5:22>
   type:          <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
-  expected type: None
+  expected type: <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
 Expr: <DottedName test.adb:12:8-43:15>
   references:    <DefiningName "Append" test.adb:5:16-5:22>
   type:          <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
   expected type: None
 Expr: <DottedName test.adb:12:8-42:17>
   references:    <DefiningName "New_Line" test.adb:6:16-6:24>
   type:          <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
-  expected type: None
+  expected type: <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
 Expr: <CallExpr test.adb:12:8-41:23>
   references:    <DefiningName "Append" test.adb:5:16-5:22>
   type:          <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
-  expected type: None
+  expected type: <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
 Expr: <DottedName test.adb:12:8-36:15>
   references:    <DefiningName "Append" test.adb:5:16-5:22>
   type:          <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
   expected type: None
 Expr: <CallExpr test.adb:12:8-35:21>
   references:    <DefiningName "Append" test.adb:5:16-5:22>
   type:          <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
-  expected type: None
+  expected type: <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
 Expr: <DottedName test.adb:12:8-35:15>
   references:    <DefiningName "Append" test.adb:5:16-5:22>
   type:          <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
   expected type: None
 Expr: <DottedName test.adb:12:8-34:17>
   references:    <DefiningName "New_Line" test.adb:6:16-6:24>
   type:          <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
-  expected type: None
+  expected type: <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
 Expr: <CallExpr test.adb:12:8-33:23>
   references:    <DefiningName "Append" test.adb:5:16-5:22>
   type:          <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
-  expected type: None
+  expected type: <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
 Expr: <DottedName test.adb:12:8-26:15>
   references:    <DefiningName "Append" test.adb:5:16-5:22>
   type:          <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
   expected type: None
 Expr: <CallExpr test.adb:12:8-25:21>
   references:    <DefiningName "Append" test.adb:5:16-5:22>
   type:          <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
-  expected type: None
+  expected type: <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
 Expr: <DottedName test.adb:12:8-25:15>
   references:    <DefiningName "Append" test.adb:5:16-5:22>
   type:          <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
   expected type: None
 Expr: <DottedName test.adb:12:8-24:17>
   references:    <DefiningName "New_Line" test.adb:6:16-6:24>
   type:          <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
-  expected type: None
+  expected type: <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
 Expr: <CallExpr test.adb:12:8-23:23>
   references:    <DefiningName "Append" test.adb:5:16-5:22>
   type:          <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
-  expected type: None
+  expected type: <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
 Expr: <DottedName test.adb:12:8-21:15>
   references:    <DefiningName "Append" test.adb:5:16-5:22>
   type:          <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
   expected type: None
 Expr: <CallExpr test.adb:12:8-20:21>
   references:    <DefiningName "Append" test.adb:5:16-5:22>
   type:          <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
-  expected type: None
+  expected type: <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
 Expr: <DottedName test.adb:12:8-20:15>
   references:    <DefiningName "Append" test.adb:5:16-5:22>
   type:          <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
   expected type: None
 Expr: <DottedName test.adb:12:8-19:17>
   references:    <DefiningName "New_Line" test.adb:6:16-6:24>
   type:          <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
-  expected type: None
+  expected type: <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
 Expr: <CallExpr test.adb:12:8-18:23>
   references:    <DefiningName "Append" test.adb:5:16-5:22>
   type:          <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
-  expected type: None
+  expected type: <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
 Expr: <DottedName test.adb:12:8-16:15>
   references:    <DefiningName "Append" test.adb:5:16-5:22>
   type:          <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
   expected type: None
 Expr: <CallExpr test.adb:12:8-15:21>
   references:    <DefiningName "Append" test.adb:5:16-5:22>
   type:          <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
-  expected type: None
+  expected type: <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
 Expr: <DottedName test.adb:12:8-15:15>
   references:    <DefiningName "Append" test.adb:5:16-5:22>
   type:          <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
   expected type: None
 Expr: <DottedName test.adb:12:8-14:17>
   references:    <DefiningName "New_Line" test.adb:6:16-6:24>
   type:          <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
-  expected type: None
+  expected type: <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
 Expr: <CallExpr test.adb:12:8-13:21>
   references:    <DefiningName "Append" test.adb:5:16-5:22>
   type:          <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
-  expected type: None
+  expected type: <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
 Expr: <DottedName test.adb:12:8-13:15>
   references:    <DefiningName "Append" test.adb:5:16-5:22>
   type:          <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
   expected type: None
 Expr: <DottedName test.adb:12:8-12:28>
   references:    <DefiningName "Empty_Vector" test.adb:8:7-8:19>
   type:          <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
-  expected type: None
+  expected type: <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
 Expr: <Id "Strings" test.adb:12:8-12:15>
   references:    <DefiningName "Strings" test.adb:2:12-2:19>
   type:          None
   expected type: None
 Expr: <Id "Empty_Vector" test.adb:12:16-12:28>
   references:    <DefiningName "Empty_Vector" test.adb:8:7-8:19>
   type:          <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
-  expected type: None
+  expected type: <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
 Expr: <Id "Append" test.adb:13:9-13:15>
   references:    <DefiningName "Append" test.adb:5:16-5:22>
   type:          <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
@@ -154,7 +154,7 @@ Expr: <Str ""a"" test.adb:13:17-13:20>
 Expr: <Id "New_Line" test.adb:14:9-14:17>
   references:    <DefiningName "New_Line" test.adb:6:16-6:24>
   type:          <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
-  expected type: None
+  expected type: <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
 Expr: <Id "Append" test.adb:15:9-15:15>
   references:    <DefiningName "Append" test.adb:5:16-5:22>
   type:          <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
@@ -199,7 +199,7 @@ Expr: <Str ""e"" test.adb:18:19-18:22>
 Expr: <Id "New_Line" test.adb:19:9-19:17>
   references:    <DefiningName "New_Line" test.adb:6:16-6:24>
   type:          <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
-  expected type: None
+  expected type: <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
 Expr: <Id "Append" test.adb:20:9-20:15>
   references:    <DefiningName "Append" test.adb:5:16-5:22>
   type:          <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
@@ -244,7 +244,7 @@ Expr: <Str ""i"" test.adb:23:19-23:22>
 Expr: <Id "New_Line" test.adb:24:9-24:17>
   references:    <DefiningName "New_Line" test.adb:6:16-6:24>
   type:          <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
-  expected type: None
+  expected type: <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
 Expr: <Id "Append" test.adb:25:9-25:15>
   references:    <DefiningName "Append" test.adb:5:16-5:22>
   type:          <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
@@ -344,7 +344,7 @@ Expr: <Str ""r"" test.adb:33:19-33:22>
 Expr: <Id "New_Line" test.adb:34:9-34:17>
   references:    <DefiningName "New_Line" test.adb:6:16-6:24>
   type:          <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
-  expected type: None
+  expected type: <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
 Expr: <Id "Append" test.adb:35:9-35:15>
   references:    <DefiningName "Append" test.adb:5:16-5:22>
   type:          <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
@@ -422,7 +422,7 @@ Expr: <Str ""x"" test.adb:41:19-41:22>
 Expr: <Id "New_Line" test.adb:42:9-42:17>
   references:    <DefiningName "New_Line" test.adb:6:16-6:24>
   type:          <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
-  expected type: None
+  expected type: <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
 Expr: <Id "Append" test.adb:43:9-43:15>
   references:    <DefiningName "Append" test.adb:5:16-5:22>
   type:          <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
@@ -434,7 +434,7 @@ Expr: <Str ""y"" test.adb:43:17-43:20>
 Expr: <Id "New_Line" test.adb:44:9-44:17>
   references:    <DefiningName "New_Line" test.adb:6:16-6:24>
   type:          <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
-  expected type: None
+  expected type: <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
 Expr: <Id "Append" test.adb:45:9-45:15>
   references:    <DefiningName "Append" test.adb:5:16-5:22>
   type:          <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
@@ -446,7 +446,7 @@ Expr: <Str ""z"" test.adb:45:17-45:20>
 Expr: <Id "New_Line" test.adb:46:9-46:17>
   references:    <DefiningName "New_Line" test.adb:6:16-6:24>
   type:          <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
-  expected type: None
+  expected type: <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>
 Expr: <Id "Append" test.adb:47:9-47:15>
   references:    <DefiningName "Append" test.adb:5:16-5:22>
   type:          <ConcreteTypeDecl ["Vector"] test.adb:3:7-3:41>

testsuite/tests/name_resolution/classwide_1/test.out

@@ -46,7 +46,7 @@ Expr: <DottedName testcw.adb:17:7-17:13>
 Expr: <Id "CW" testcw.adb:17:7-17:9>
   references:    <DefiningName "CW" testcw.adb:15:7-15:9>
   type:          <ClasswideTypeDecl ["A"] testcw.adb:3:7-5:18>
-  expected type: None
+  expected type: <ConcreteTypeDecl ["A"] testcw.adb:3:7-5:18>
 Expr: <Id "Foo" testcw.adb:17:10-17:13>
   references:    <DefiningName "Foo" testcw.adb:7:17-7:20>
   type:          None

testsuite/tests/name_resolution/constrain_prefix_subp_body/test.adb

@@ -0,0 +1,21 @@
+procedure Test is
+   package Pkg1 is
+      type T is tagged null record;
+
+      function Foo (X : T) return Integer is (1);
+   end Pkg1;
+
+   package Pkg2 is
+      type T is tagged null record;
+
+      function Foo (X : T) return Integer is (2);
+   end Pkg2;
+
+   function Bar (X : Integer) return Pkg1.T is (null record);
+   function Bar (Y : Boolean) return Pkg2.T is (null record);
+
+   X : Integer;
+begin
+   X := Bar (1).Foo;
+   pragma Test_Statement;
+end Test;

testsuite/tests/name_resolution/constrain_prefix_subp_body/test.out

@@ -0,0 +1,33 @@
+Analyzing test.adb
+##################
+
+Resolving xrefs for node <AssignStmt test.adb:19:4-19:21>
+*********************************************************
+
+Expr: <Id "X" test.adb:19:4-19:5>
+  references:    <DefiningName "X" test.adb:17:4-17:5>
+  type:          <ConcreteTypeDecl ["Integer"] __standard:4:3-4:54>
+  expected type: None
+Expr: <DottedName test.adb:19:9-19:20>
+  references:    <DefiningName "Foo" test.adb:5:16-5:19>
+  type:          <ConcreteTypeDecl ["Integer"] __standard:4:3-4:54>
+  expected type: <ConcreteTypeDecl ["Integer"] __standard:4:3-4:54>
+Expr: <CallExpr test.adb:19:9-19:16>
+  references:    <DefiningName "Bar" test.adb:14:13-14:16>
+  type:          <ConcreteTypeDecl ["T"] test.adb:3:7-3:36>
+  expected type: <ConcreteTypeDecl ["T"] test.adb:3:7-3:36>
+Expr: <Id "Bar" test.adb:19:9-19:12>
+  references:    <DefiningName "Bar" test.adb:14:13-14:16>
+  type:          <ConcreteTypeDecl ["T"] test.adb:3:7-3:36>
+  expected type: None
+Expr: <Int test.adb:19:14-19:15>
+  references:    None
+  type:          <ConcreteTypeDecl ["Universal_Int_Type_"] __standard:116:3-116:45>
+  expected type: <ConcreteTypeDecl ["Integer"] __standard:4:3-4:54>
+Expr: <Id "Foo" test.adb:19:17-19:20>
+  references:    <DefiningName "Foo" test.adb:5:16-5:19>
+  type:          <ConcreteTypeDecl ["Integer"] __standard:4:3-4:54>
+  expected type: <ConcreteTypeDecl ["Integer"] __standard:4:3-4:54>
+
+
+Done.

testsuite/tests/name_resolution/constrain_prefix_subp_body/test.yaml

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

testsuite/tests/name_resolution/dotted_call/test.out

@@ -71,7 +71,7 @@ Expr: <DottedName test.adb:31:4-31:8>
 Expr: <Id "O" test.adb:31:4-31:5>
   references:    <DefiningName "O" test.adb:23:4-23:5>
   type:          <ConcreteTypeDecl ["T"] test.adb:7:7-7:36>
-  expected type: None
+  expected type: <AnonymousTypeDecl ["None"] test.adb:13:25-13:39>
 Expr: <Id "P4" test.adb:31:6-31:8>
   references:    <DefiningName "P4" test.adb:13:17-13:19>
   type:          None
@@ -87,7 +87,7 @@ Expr: <DottedName test.adb:33:4-33:8>
 Expr: <Id "O" test.adb:33:4-33:5>
   references:    <DefiningName "O" test.adb:23:4-23:5>
   type:          <ConcreteTypeDecl ["T"] test.adb:7:7-7:36>
-  expected type: None
+  expected type: <AnonymousTypeDecl ["None"] test.adb:14:28-14:42>
 Expr: <Id "P5" test.adb:33:6-33:8>
   references:    <DefiningName "P5" test.adb:14:17-14:19>
   type:          None
@@ -103,7 +103,7 @@ Expr: <DottedName test.adb:35:4-35:8>
 Expr: <Id "O" test.adb:35:4-35:5>
   references:    <DefiningName "O" test.adb:23:4-23:5>
   type:          <ConcreteTypeDecl ["T"] test.adb:7:7-7:36>
-  expected type: None
+  expected type: <AnonymousTypeDecl ["None"] test.adb:15:28-15:42>
 Expr: <Id "P6" test.adb:35:6-35:8>
   references:    <DefiningName "P6" test.adb:15:17-15:19>
   type:          None

testsuite/tests/name_resolution/field_hiding/test.out

@@ -51,7 +51,7 @@ Expr: <DottedName test.adb:23:19-23:24>
 Expr: <Id "X" test.adb:23:19-23:20>
   references:    <DefiningName "X" test.adb:19:4-19:5>
   type:          <ConcreteTypeDecl ["T"] test.adb:3:7-5:18>
-  expected type: None
+  expected type: <ConcreteTypeDecl ["T"] test.adb:3:7-5:18>
 Expr: <Id "Bar" test.adb:23:21-23:24>
   references:    <DefiningName "Bar" test.adb:8:16-8:19>
   type:          <ConcreteTypeDecl ["Integer"] __standard:4:3-4:54>

testsuite/tests/name_resolution/interfaces/test.out

@@ -103,7 +103,7 @@ Expr: <DottedName testifc.adb:17:4-17:18>
 Expr: <Id "Inst" testifc.adb:17:4-17:8>
   references:    <DefiningName "Inst" testifc.adb:12:4-12:8>
   type:          <ConcreteTypeDecl ["B"] testifc.adb:10:4-10:43>
-  expected type: None
+  expected type: <ConcreteTypeDecl ["A"] testifc.adb:4:4-4:24>
 Expr: <Id "Frobulize" testifc.adb:17:9-17:18>
   references:    <DefiningName "Frobulize" testifc.adb:5:14-5:23>
   type:          None

testsuite/tests/name_resolution/pre_cond_type_view/test.out

@@ -31,7 +31,7 @@ Expr: <DottedName test_pre_class.ads:6:16-6:24>
 Expr: <Id "Self" test_pre_class.ads:6:16-6:20>
   references:    <DefiningName "Self" test_pre_class.ads:5:7-5:11>
   type:          <ConcreteTypeDecl ["T"] test_pre_class.ads:9:4-9:42>
-  expected type: None
+  expected type: <ConcreteTypeDecl ["T"] test_pre_class.ads:9:4-9:42>
 Expr: <Id "Why" test_pre_class.ads:6:21-6:24>
   references:    <DefiningName "Why" test_pre_class.ads:10:13-10:16>
   type:          <ConcreteTypeDecl ["Boolean"] __standard:3:3-3:33>