Merge branch 'topic/1381' into 'master'

Fix name resolution of assocs in declare expression env

Closes #1381

See merge request eng/libadalang/libadalang!1653

ada/ast.py

@@ -1055,7 +1055,10 @@ def resolve_children_names(generate_diagnostics=Bool):
                     c.as_entity.xref_stop_resolution,
                     entry_point.bind(
                         c,
-                        c.as_entity.resolve_own_names(generate_diagnostics)
+                        env.bind(
+                            Entity.xref_initial_env,
+                            c.as_entity.resolve_own_names(generate_diagnostics)
+                        )
                     ),
                     True
                 ) & c.as_entity.resolve_children_names(generate_diagnostics),
@@ -1112,100 +1115,68 @@ def resolve_names():
             origin.bind(Self.origin_node, Entity.resolve_names_internal(False))
         )
 
-    @langkit_property(return_type=T.LexicalEnv)
-    def resolve_names_from_closest_entry_point_impl():
+    @langkit_property(return_type=Bool)
+    def resolve_names_from_closest_entry_point():
         """
-        Implementation helper for ``resolve_names_from_closest_entry_point``.
-        Instead of returning a Boolean, it returns a LexicalEnv, which is
-        either None (indicating that resolution failed), or contains the
-        lexical environment which the children of that node should bind when
-        resolving their own names. This allows propagating the initial env
-        we got from ``Entity.xref_initial_env`` on the closest xref entry
-        point.
+        Resolve names from the closest entry point up to this node. Note that
+        unlike ``resolve_names``, this will *not* trigger resolution of every
+        node with stop_resolution that lie in the sub-tree formed by the
+        closest entry point. It will only resolve those that are in the path to
+        resolving Self. Consider for example the following entry point:
+
+        .. code::
+
+            R := (A, B);
+
+        Since aggregate association nodes have ``stop_resolution`` set to True,
+        calling ``resolve_names_from_closest_entry_point`` on ``B`` will
+        resolve nodes ``R`` and ``B`` but not ``A``, because ``A`` does not lie
+        on the path to ``B``.
+
+        This can be useful for resolving aggregates of variant records, because
+        resolution of a component association can safely call the resolution
+        of a discriminant association without triggering an infinite recursion,
+        as both are on different "paths".
         """
         return If(
-            # This is the closest entry point: resolve its names and return
-            # its `xref_initial_env` if resolution succeeded, so that children
-            # will be able to use it to resolve their own names.
+            # This is the closest entry point: resolve its names and stop the
+            # recursion.
             Entity.xref_entry_point,
             env.bind(
                 Entity.xref_initial_env,
                 origin.bind(
                     Self.origin_node,
                     entry_point.bind(
                         Self,
-                        If(Entity.resolve_own_names(False),
-                           env,
-                           No(LexicalEnv))
+                        Entity.resolve_own_names(False)
                     )
                 )
             ),
 
-            Let(
-                # Recurse in order to resolve names from the closest entry
-                # point: `res` will contain the environment to use if we need
-                # to resolve names inside Self, or None if resolution failed.
-                lambda
-                res=Entity.parent
-                ._.resolve_names_from_closest_entry_point_impl:
-
-                env.bind(
-                    res,
+            # Otherwise, recurse on the parent
+            Entity.parent._.resolve_names_from_closest_entry_point.then(
+                lambda _: env.bind(
+                    Entity.xref_initial_env,
                     origin.bind(
                         Self.origin_node,
-                        Cond(
-                            # Resolution failed for the parent, so return None
-                            # as well.
-                            res == No(T.LexicalEnv),
-                            res,
-
+                        If(
                             # Resolution succeeded for the parent and this is a
-                            # stop resolution, so re-use the parent environment
-                            # to resolve Self's names.
+                            # stop resolution, so resolve own names as well.
                             Entity.xref_stop_resolution,
                             entry_point.bind(
                                 Self,
-                                If(Entity.resolve_own_names(False),
-                                   res,
-                                   No(LexicalEnv))
+                                Entity.resolve_own_names(False)
                             ),
 
-                            # Resolution succeeded but there is nothing to do
-                            # on that particular node: return the parent
-                            # environment, so that deeper children can use it.
-                            res
+                            # Resolution succeeded and there is nothing to do
+                            # on that particular node: return successfully.
+                            True
                         )
                     )
                 )
             )
         )
 
-    @langkit_property(return_type=Bool)
-    def resolve_names_from_closest_entry_point():
-        """
-        Resolve names from the closest entry point up to this node. Note that
-        unlike ``resolve_names``, this will *not* trigger resolution of every
-        node with stop_resolution that lie in the sub-tree formed by the
-        closest entry point. It will only resolve those that are in the path to
-        resolving Self. Consider for example the following entry point:
-
-        .. code::
-
-            R := (A, B);
-
-        Since aggregate association nodes have ``stop_resolution`` set to True,
-        calling ``resolve_names_from_closest_entry_point`` on ``B`` will
-        resolve nodes ``R`` and ``B`` but not ``A``, because ``A`` does not lie
-        on the path to ``B``.
-
-        This can be useful for resolving aggregates of variant records, because
-        resolution of a component association can safely call the resolution
-        of a discriminant association without triggering an infinite recursion,
-        as both are on different "paths".
-        """
-        result = Var(Entity.resolve_names_from_closest_entry_point_impl)
-        return result != No(LexicalEnv)
-
     @langkit_property(return_type=T.SolverDiagnostic.array, external=True,
                       call_memoizable=True, uses_entity_info=True,
                       uses_envs=True)

testsuite/tests/name_resolution/declare_expr_aggregate/test.adb

@@ -0,0 +1,29 @@
+pragma Ada_2022;
+
+procedure Test is
+   type A is array (Natural range 0 .. 1) of Integer;
+
+   function F return A is
+     (declare
+        I : constant Integer := 0;
+        J : constant Integer := 1;
+      begin (I, J));
+   pragma Test_Statement;
+
+   function G return Integer is
+     (declare
+        K : constant Integer := 2;
+      begin (K));
+   pragma Test_Statement;
+
+   type B is array (Natural range 0 .. 1) of A;
+   K : Integer := 3;
+
+   function H return B is
+     (declare
+        K : constant Integer := 2;
+      begin (B'First => (K, K), B'Last => (K, K)));
+   pragma Test_Statement;
+begin
+   null;
+end;

testsuite/tests/name_resolution/declare_expr_aggregate/test.out

@@ -0,0 +1,102 @@
+Analyzing test.adb
+##################
+
+Resolving xrefs for node <ExprFunction ["F"] test.adb:6:4-10:21>
+****************************************************************
+
+Expr: <ParenExpr test.adb:7:6-10:20>
+  type:          <ConcreteTypeDecl ["A"] test.adb:4:4-4:54>
+  expected type: <ConcreteTypeDecl ["A"] test.adb:4:4-4:54>
+Expr: <DeclExpr test.adb:7:7-10:19>
+  type:          <ConcreteTypeDecl ["A"] test.adb:4:4-4:54>
+  expected type: <ConcreteTypeDecl ["A"] test.adb:4:4-4:54>
+Expr: <Aggregate test.adb:10:13-10:19>
+  type:          <ConcreteTypeDecl ["A"] test.adb:4:4-4:54>
+  expected type: <ConcreteTypeDecl ["A"] test.adb:4:4-4:54>
+Expr: <Id "I" test.adb:10:14-10:15>
+  references:    <DefiningName "I" test.adb:8:9-8:10>
+  type:          <ConcreteTypeDecl ["Integer"] __standard:4:3-4:54>
+  expected type: <ConcreteTypeDecl ["Integer"] __standard:4:3-4:54>
+Expr: <Id "J" test.adb:10:17-10:18>
+  references:    <DefiningName "J" test.adb:9:9-9:10>
+  type:          <ConcreteTypeDecl ["Integer"] __standard:4:3-4:54>
+  expected type: <ConcreteTypeDecl ["Integer"] __standard:4:3-4:54>
+
+Resolving xrefs for node <ExprFunction ["G"] test.adb:13:4-16:18>
+*****************************************************************
+
+Expr: <ParenExpr test.adb:14:6-16:17>
+  type:          <ConcreteTypeDecl ["Integer"] __standard:4:3-4:54>
+  expected type: <ConcreteTypeDecl ["Integer"] __standard:4:3-4:54>
+Expr: <DeclExpr test.adb:14:7-16:16>
+  type:          <ConcreteTypeDecl ["Integer"] __standard:4:3-4:54>
+  expected type: <ConcreteTypeDecl ["Integer"] __standard:4:3-4:54>
+Expr: <ParenExpr test.adb:16:13-16:16>
+  type:          <ConcreteTypeDecl ["Integer"] __standard:4:3-4:54>
+  expected type: <ConcreteTypeDecl ["Integer"] __standard:4:3-4:54>
+Expr: <Id "K" test.adb:16:14-16:15>
+  references:    <DefiningName "K" test.adb:15:9-15:10>
+  type:          <ConcreteTypeDecl ["Integer"] __standard:4:3-4:54>
+  expected type: <ConcreteTypeDecl ["Integer"] __standard:4:3-4:54>
+
+Resolving xrefs for node <ExprFunction ["H"] test.adb:22:4-25:52>
+*****************************************************************
+
+Expr: <ParenExpr test.adb:23:6-25:51>
+  type:          <ConcreteTypeDecl ["B"] test.adb:19:4-19:48>
+  expected type: <ConcreteTypeDecl ["B"] test.adb:19:4-19:48>
+Expr: <DeclExpr test.adb:23:7-25:50>
+  type:          <ConcreteTypeDecl ["B"] test.adb:19:4-19:48>
+  expected type: <ConcreteTypeDecl ["B"] test.adb:19:4-19:48>
+Expr: <Aggregate test.adb:25:13-25:50>
+  type:          <ConcreteTypeDecl ["B"] test.adb:19:4-19:48>
+  expected type: <ConcreteTypeDecl ["B"] test.adb:19:4-19:48>
+Expr: <AttributeRef test.adb:25:14-25:21>
+  references:    None
+  type:          <SubtypeDecl ["Natural"] __standard:5:3-5:57>
+  expected type: <SubtypeDecl ["Natural"] __standard:5:3-5:57>
+Expr: <Id "B" test.adb:25:14-25:15>
+  references:    <DefiningName "B" test.adb:19:9-19:10>
+  type:          None
+  expected type: None
+Expr: <Id "First" test.adb:25:16-25:21>
+  references:    None
+  type:          None
+  expected type: None
+Expr: <Aggregate test.adb:25:25-25:31>
+  type:          <ConcreteTypeDecl ["A"] test.adb:4:4-4:54>
+  expected type: <ConcreteTypeDecl ["A"] test.adb:4:4-4:54>
+Expr: <Id "K" test.adb:25:26-25:27>
+  references:    <DefiningName "K" test.adb:24:9-24:10>
+  type:          <ConcreteTypeDecl ["Integer"] __standard:4:3-4:54>
+  expected type: <ConcreteTypeDecl ["Integer"] __standard:4:3-4:54>
+Expr: <Id "K" test.adb:25:29-25:30>
+  references:    <DefiningName "K" test.adb:24:9-24:10>
+  type:          <ConcreteTypeDecl ["Integer"] __standard:4:3-4:54>
+  expected type: <ConcreteTypeDecl ["Integer"] __standard:4:3-4:54>
+Expr: <AttributeRef test.adb:25:33-25:39>
+  references:    None
+  type:          <SubtypeDecl ["Natural"] __standard:5:3-5:57>
+  expected type: <SubtypeDecl ["Natural"] __standard:5:3-5:57>
+Expr: <Id "B" test.adb:25:33-25:34>
+  references:    <DefiningName "B" test.adb:19:9-19:10>
+  type:          None
+  expected type: None
+Expr: <Id "Last" test.adb:25:35-25:39>
+  references:    None
+  type:          None
+  expected type: None
+Expr: <Aggregate test.adb:25:43-25:49>
+  type:          <ConcreteTypeDecl ["A"] test.adb:4:4-4:54>
+  expected type: <ConcreteTypeDecl ["A"] test.adb:4:4-4:54>
+Expr: <Id "K" test.adb:25:44-25:45>
+  references:    <DefiningName "K" test.adb:24:9-24:10>
+  type:          <ConcreteTypeDecl ["Integer"] __standard:4:3-4:54>
+  expected type: <ConcreteTypeDecl ["Integer"] __standard:4:3-4:54>
+Expr: <Id "K" test.adb:25:47-25:48>
+  references:    <DefiningName "K" test.adb:24:9-24:10>
+  type:          <ConcreteTypeDecl ["Integer"] __standard:4:3-4:54>
+  expected type: <ConcreteTypeDecl ["Integer"] __standard:4:3-4:54>
+
+
+Done.

testsuite/tests/name_resolution/declare_expr_aggregate/test.yaml

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

testsuite/tests/name_resolution/declare_expr_aggregate_2/test.adb

@@ -0,0 +1,23 @@
+pragma Ada_2022;
+
+procedure Test is
+   type A is array (Natural range 0 .. 1) of Integer;
+
+   function F return A is
+     (declare
+        I : constant Integer := 0;
+        J : constant Integer := 1;
+      begin (I, J));
+   --% node.findall(lal.AggregateAssoc)[0].f_r_expr.p_referenced_decl()
+
+   type B is array (Natural range 0 .. 1) of A;
+   K : Integer := 3;
+
+   function H return B is
+     (declare
+        K : constant Integer := 2;
+      begin (B'First => (K, K), B'Last => (K, K)));
+   --% node.findall(lal.AggregateAssoc)[-1].f_r_expr.p_referenced_decl()
+begin
+   null;
+end;

testsuite/tests/name_resolution/declare_expr_aggregate_2/test.out

@@ -0,0 +1,11 @@
+Working on node <ExprFunction ["F"] test.adb:6:4-10:21>
+=======================================================
+
+Eval 'node.findall(lal.AggregateAssoc)[0].f_r_expr.p_referenced_decl()'
+Result: <ObjectDecl ["I"] test.adb:8:9-8:35>
+
+Working on node <ExprFunction ["H"] test.adb:16:4-19:52>
+========================================================
+
+Eval 'node.findall(lal.AggregateAssoc)[-1].f_r_expr.p_referenced_decl()'
+Result: <ObjectDecl ["K"] test.adb:18:9-18:35>

testsuite/tests/name_resolution/declare_expr_aggregate_2/test.yaml

@@ -0,0 +1,2 @@
+driver: inline-playground
+input_sources: [test.adb]