diff --git a/ada/ast.py b/ada/ast.py index a05776b25..8d6f2065c 100644 --- a/ada/ast.py +++ b/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() + ) ) ) diff --git a/testsuite/tests/name_resolution/implicit_deref_2/iterators.adb b/testsuite/tests/name_resolution/implicit_deref_2/iterators.adb new file mode 100644 index 000000000..c94ac1884 --- /dev/null +++ b/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; diff --git a/testsuite/tests/name_resolution/implicit_deref_2/iterators.ads b/testsuite/tests/name_resolution/implicit_deref_2/iterators.ads new file mode 100644 index 000000000..920cbeeaa --- /dev/null +++ b/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; diff --git a/testsuite/tests/name_resolution/implicit_deref_2/test.out b/testsuite/tests/name_resolution/implicit_deref_2/test.out new file mode 100644 index 000000000..cdced6615 --- /dev/null +++ b/testsuite/tests/name_resolution/implicit_deref_2/test.out @@ -0,0 +1,65 @@ +Analyzing iterators.adb +####################### + +Resolving xrefs for node +************************************************************ + +Expr: + references: + type: + expected type: None +Expr: + references: + type: + expected type: +Expr: + references: + type: + expected type: None +Expr: + references: None + type: + expected type: +Expr: + references: + type: + expected type: +Expr: + references: None + type: None + expected type: None +Expr: + references: + type: + expected type: None +Expr: + references: + type: + expected type: + +Resolving xrefs for node +********************************************************** + +Expr: + references: + type: None + expected type: None +Expr: + references: None + type: + expected type: +Expr: + references: + type: + expected type: +Expr: + references: None + type: None + expected type: None +Expr: + references: + type: None + expected type: None + + +Done. diff --git a/testsuite/tests/name_resolution/implicit_deref_2/test.yaml b/testsuite/tests/name_resolution/implicit_deref_2/test.yaml new file mode 100644 index 000000000..2204f3a5d --- /dev/null +++ b/testsuite/tests/name_resolution/implicit_deref_2/test.yaml @@ -0,0 +1,2 @@ +driver: name-resolution +input_sources: [iterators.adb] diff --git a/testsuite/tests/name_resolution/unrestricted_access_implicit_deref/test.out b/testsuite/tests/name_resolution/unrestricted_access_implicit_deref/test.out index 0a96f2a0b..dcf4a6510 100644 --- a/testsuite/tests/name_resolution/unrestricted_access_implicit_deref/test.out +++ b/testsuite/tests/name_resolution/unrestricted_access_implicit_deref/test.out @@ -11,11 +11,11 @@ Expr: Expr: references: None type: - expected type: None + expected type: Expr: references: type: - expected type: None + expected type: Expr: references: None type: None diff --git a/user_manual/changes/1004.yaml b/user_manual/changes/1004.yaml new file mode 100644 index 000000000..5b7c1b455 --- /dev/null +++ b/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 +