Properly resolve implicit dereferences of access attributes.

ada/ast.py

@@ -5011,14 +5011,10 @@ class ComponentDecl(BaseFormalParamDecl):
     @langkit_property(return_type=Equation)
     def constrain_prefix(prefix=T.Expr):
         return If(
-            # If the prefix is `X'Unrestricted_Access`, we have an implicit
-            # dereference. Do not constrain the equation further here and let
-            # the AttributeRef's xref_equation handle this case.
-            prefix.cast(AttributeRef)._.is_access_attr
             # If Self is a component of a SingleProtectedDecl or
             # ProtectedTypeDecl, do not constrain the equation further since
             # they do not have a type.
-            | Self.parents.any(lambda p: p.is_a(ProtectedDef)),
+            Self.parents.any(lambda p: p.is_a(ProtectedDef)),
 
             LogicTrue(),
 
@@ -19874,12 +19870,22 @@ def access_equation():
                     Entity.prefix.matches_expected_formal_type
                 ),
 
-                # If the expected type is not known, synthesize an anonymous
-                # access type for this expression.
-                Bind(Self.expected_type_var, No(BaseTypeDecl.entity))
-                & Bind(Self.prefix.type_var,
-                       Self.type_var,
-                       conv_prop=BaseTypeDecl.anonymous_access_type_or_null)
+                # If this `X'Access` is the prefix of a DottedName, we may be
+                # resolving an implicit dereference. In that case, our expected
+                # type is also the expected type of the prefix `X`, and we
+                # should synthesize an anonymous access type for the actual
+                # type of `X'Access`.
+                If(
+                    Self.parent.is_a(DottedName) & Self.is_prefix,
+                    Bind(Self.prefix.expected_type_var, Self.expected_type_var)
+                    & Entity.prefix.matches_expected_formal_type
+                    & Bind(
+                        Self.prefix.type_var,
+                        Self.type_var,
+                        conv_prop=BaseTypeDecl.anonymous_access_type_or_null
+                    ),
+                    LogicFalse()
+                )
             )
         )
 

testsuite/tests/name_resolution/implicit_deref_2/iterators.adb

@@ -0,0 +1,17 @@
+package body Iterators is
+   function Consume (I : in Iterator'Class) return Element_Array is
+      Element : Element_Type;
+      B       : Boolean;
+   begin
+      B := I'Unrestricted_Access.Next (Element);
+      pragma Test_Statement;
+      I'Unrestricted_Access.Foo;
+      pragma Test_Statement;
+
+      declare
+         Result : Element_Array (1 .. 4);
+      begin
+         return Result;
+      end;
+   end Consume;
+end Iterators;

testsuite/tests/name_resolution/implicit_deref_2/iterators.ads

@@ -0,0 +1,16 @@
+generic
+   type Element_Type is private;
+   type Element_Array is array (Positive range <>) of Element_Type;
+package Iterators is
+
+   type Iterator is interface;
+
+   function Next
+     (I       : in out Iterator;
+      Element : out Element_Type) return Boolean is abstract;
+
+   procedure Foo (I : access Iterator) is abstract;
+
+   function Consume (I : in Iterator'Class) return Element_Array;
+
+end Iterators;

testsuite/tests/name_resolution/implicit_deref_2/test.out

@@ -0,0 +1,65 @@
+Analyzing iterators.adb
+#######################
+
+Resolving xrefs for node <AssignStmt iterators.adb:6:7-6:49>
+************************************************************
+
+Expr: <Id "B" iterators.adb:6:7-6:8>
+  references:    <DefiningName "B" iterators.adb:4:7-4:8>
+  type:          <ConcreteTypeDecl ["Boolean"] __standard:3:3-3:33>
+  expected type: None
+Expr: <CallExpr iterators.adb:6:12-6:48>
+  references:    <DefiningName "Next" iterators.ads:8:13-8:17>
+  type:          <ConcreteTypeDecl ["Boolean"] __standard:3:3-3:33>
+  expected type: <ConcreteTypeDecl ["Boolean"] __standard:3:3-3:33>
+Expr: <DottedName iterators.adb:6:12-6:38>
+  references:    <DefiningName "Next" iterators.ads:8:13-8:17>
+  type:          <ConcreteTypeDecl ["Boolean"] __standard:3:3-3:33>
+  expected type: None
+Expr: <AttributeRef iterators.adb:6:12-6:33>
+  references:    None
+  type:          <SynthAnonymousTypeDecl ["Iterator"] iterators.ads:6:4-6:31>
+  expected type: <ConcreteTypeDecl ["Iterator"] iterators.ads:6:4-6:31>
+Expr: <Id "I" iterators.adb:6:12-6:13>
+  references:    <DefiningName "I" iterators.adb:2:22-2:23>
+  type:          <ClasswideTypeDecl ["Iterator"] iterators.ads:6:4-6:31>
+  expected type: <ConcreteTypeDecl ["Iterator"] iterators.ads:6:4-6:31>
+Expr: <Id "Unrestricted_Access" iterators.adb:6:14-6:33>
+  references:    None
+  type:          None
+  expected type: None
+Expr: <Id "Next" iterators.adb:6:34-6:38>
+  references:    <DefiningName "Next" iterators.ads:8:13-8:17>
+  type:          <ConcreteTypeDecl ["Boolean"] __standard:3:3-3:33>
+  expected type: None
+Expr: <Id "Element" iterators.adb:6:40-6:47>
+  references:    <DefiningName "Element" iterators.adb:3:7-3:14>
+  type:          <FormalTypeDecl ["Element_Type"] iterators.ads:2:4-2:33>
+  expected type: <FormalTypeDecl ["Element_Type"] iterators.ads:2:4-2:33>
+
+Resolving xrefs for node <CallStmt iterators.adb:8:7-8:33>
+**********************************************************
+
+Expr: <DottedName iterators.adb:8:7-8:32>
+  references:    <DefiningName "Foo" iterators.ads:12:14-12:17>
+  type:          None
+  expected type: None
+Expr: <AttributeRef iterators.adb:8:7-8:28>
+  references:    None
+  type:          <AnonymousTypeDecl ["None"] iterators.ads:12:23-12:38>
+  expected type: <AnonymousTypeDecl ["None"] iterators.ads:12:23-12:38>
+Expr: <Id "I" iterators.adb:8:7-8:8>
+  references:    <DefiningName "I" iterators.adb:2:22-2:23>
+  type:          <ClasswideTypeDecl ["Iterator"] iterators.ads:6:4-6:31>
+  expected type: <ConcreteTypeDecl ["Iterator"] iterators.ads:6:4-6:31>
+Expr: <Id "Unrestricted_Access" iterators.adb:8:9-8:28>
+  references:    None
+  type:          None
+  expected type: None
+Expr: <Id "Foo" iterators.adb:8:29-8:32>
+  references:    <DefiningName "Foo" iterators.ads:12:14-12:17>
+  type:          None
+  expected type: None
+
+
+Done.

testsuite/tests/name_resolution/implicit_deref_2/test.yaml

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

testsuite/tests/name_resolution/unrestricted_access_implicit_deref/test.out

@@ -11,11 +11,11 @@ Expr: <DottedName test.adb:8:4-8:27>
 Expr: <AttributeRef test.adb:8:4-8:25>
   references:    None
   type:          <SynthAnonymousTypeDecl ["R"] test.adb:2:4-4:15>
-  expected type: None
+  expected type: <ConcreteTypeDecl ["R"] test.adb:2:4-4:15>
 Expr: <Id "X" test.adb:8:4-8:5>
   references:    <DefiningName "X" test.adb:6:4-6:5>
   type:          <ConcreteTypeDecl ["R"] test.adb:2:4-4:15>
-  expected type: None
+  expected type: <ConcreteTypeDecl ["R"] test.adb:2:4-4:15>
 Expr: <Id "Unrestricted_Access" test.adb:8:6-8:25>
   references:    None
   type:          None

user_manual/changes/1004.yaml

@@ -0,0 +1,8 @@
+type: bugfix
+title: Support implicit dereference of access attributes
+description: |
+  This change fixes a bug where implicit dereferences of access attributes
+  as in ``X'Unrestricted_Access.Foo (2)`` were not properly resolved, which
+  could cause property errors to be raised during name resolution.
+date: 2023-09-18
+