Merge branch 'topic/1266' into 'master'

Improve iterator/indexing types and Implicit_Dereference aspect support

Closes #1266

See merge request eng/libadalang/libadalang!1548

ada/ast.py

@@ -7826,18 +7826,6 @@ def matching_assign_type(expected_type=T.BaseTypeDecl.entity):
                 actual_type.matching_formal_prim_type(expected_type)
             ),
 
-            And(
-                Not(actual_type.get_imp_deref.is_null),
-                actual_type
-                .accessed_type.matching_assign_type(expected_type)
-            ),
-
-            And(
-                Not(expected_type.get_imp_deref.is_null),
-                expected_type
-                .accessed_type.matching_assign_type(actual_type)
-            ),
-
             Entity.matching_access_type(expected_type, True)
         )
 
@@ -7873,6 +7861,18 @@ def matching_type(expected_type=T.BaseTypeDecl.entity):
 
                 actual_type.canonical_type == expected_type.canonical_type,
 
+                And(
+                    Not(actual_type.get_imp_deref.is_null),
+                    actual_type
+                    .accessed_type.matching_type(expected_type)
+                ),
+
+                And(
+                    Not(expected_type.get_imp_deref.is_null),
+                    expected_type
+                    .accessed_type.matching_type(actual_type)
+                ),
+
                 actual_type.matching_access_type(expected_type, False)
             )
         )
@@ -8460,17 +8460,16 @@ class TypeDecl(BaseTypeDecl):
     is_iterable_type = Property(
         Or(
             Entity.is_array,
-            Not(Entity.get_aspect_spec_expr('Iterator_Element').is_null),
+            Not(Entity.get_aspect('Iterator_Element', True).value.is_null),
             # TODO: The optional `Element` assoc must be defined, if not, a
             # type with the aspect `Iterable` only supports iteration over
             # cursors through the `for .. in` loop (W303-007).
-            Not(Entity.get_aspect_spec_expr('Iterable').is_null),
+            Not(Entity.get_aspect('Iterable', True).value.is_null),
             Entity.type_def.match(
                 lambda dtd=T.DerivedTypeDef:
                 dtd.base_type.then(lambda bt: bt.is_iterable_type),
                 lambda _: False
-            ),
-            Entity.previous_part(False).then(lambda pp: pp.is_iterable_type)
+            )
         ),
         doc="""
         Whether Self is a type that is iterable in a for .. of loop
@@ -8480,8 +8479,8 @@ class TypeDecl(BaseTypeDecl):
 
     @langkit_property()
     def iterable_comp_type():
-        ie = Var(Entity.get_aspect_spec_expr('Iterator_Element'))
-        it = Var(Entity.get_aspect_spec_expr('Iterable'))
+        ie = Var(Entity.get_aspect('Iterator_Element', True).value)
+        it = Var(Entity.get_aspect('Iterable', True).value)
 
         return imprecise_fallback.bind(False, Cond(
             Entity.is_array, Entity.comp_type,
@@ -8746,18 +8745,18 @@ def refined_parent_primitives_env():
         )
 
     get_imp_deref = Property(
-        Entity.get_aspect_spec_expr('Implicit_Dereference')
+        Entity.get_aspect('Implicit_Dereference', True).value
     )
 
     has_ud_indexing = Property(
-        Not(Entity.get_aspect_spec_expr('Constant_Indexing').is_null)
-        | Not(Entity.get_aspect_spec_expr('Variable_Indexing').is_null)
+        Not(Entity.get_aspect('Constant_Indexing').value.is_null)
+        | Not(Entity.get_aspect('Variable_Indexing').value.is_null)
     )
 
     @langkit_property()
     def constant_indexing_fns():
         return (
-            Entity.get_aspect_spec_expr('Constant_Indexing')
+            Entity.get_aspect('Constant_Indexing', True).value
             ._.cast_or_raise(T.Name).all_env_elements_internal(seq=False)
             .filtermap(
                 lambda e: e.cast(T.BasicDecl),
@@ -8774,7 +8773,7 @@ def constant_indexing_fns():
 
     @langkit_property()
     def variable_indexing_fns():
-        return Entity.get_aspect_spec_expr('Variable_Indexing').then(
+        return Entity.get_aspect('Variable_Indexing', True).value.then(
             lambda a: a.cast_or_raise(T.Name)
             .all_env_elements_internal(seq=False).filtermap(
                 lambda e: e.cast(T.BasicDecl),
@@ -18335,7 +18334,7 @@ def get_aspect_on_parts(name=Symbol, inherited=Bool,
             )
         )
 
-    @langkit_property(return_type=Aspect, public=True,
+    @langkit_property(return_type=Aspect, public=True, memoized=True,
                       dynamic_vars=[default_imprecise_fallback()])
     def get_aspect(name=Symbol, previous_parts_only=(Bool, False)):
         """

testsuite/tests/name_resolution/implicit_deref_3/test.adb

@@ -0,0 +1,59 @@
+procedure Test is
+
+   package P is
+      type T is tagged null record;
+      type T_Element is access all T;
+
+      function Key (This : in T) return Integer is (1);
+
+      type T_Constant_Reference (Element : access constant T_Element) is private
+         with Implicit_Dereference => Element;
+
+      type MyArr (Capacity : Integer) is tagged private
+         with Constant_Indexing => Query,
+              Iterator_Element  => T_Element;
+
+      type Elems_Access is access all MyArr;
+
+      function Query(This: MyArr; Index : Integer) return T_Constant_Reference;
+   private
+      type T_Constant_Reference
+        (Element : access constant T_Element) is null record;
+      type MyArr (Capacity : Integer) is tagged null record;
+   end P;
+
+   package body P is
+      function Query
+        (This: MyArr; Index : Integer) return T_Constant_Reference is
+          (T_Constant_Reference'(Element => null));
+
+      procedure X (Elems : Elems_Access) is
+         T : T_Element := Elems.all (1);
+         pragma Test_Statement;
+         C : T_Constant_Reference := Elems.all (1);
+         pragma Test_Statement;
+         I : Integer := Elems.all (1).all.Key;
+         pragma Test_Statement;
+      begin
+         I := Elems.all (1).all.Key;
+         pragma Test_Statement;
+      end X;
+   end P;
+
+   use P;
+
+   procedure Y (Elems : Elems_Access) is
+      T : T_Element := Elems.all (1);
+      pragma Test_Statement;
+      C : T_Constant_Reference := Elems.all (1);
+      pragma Test_Statement;
+      I : Integer := Elems.all (1).all.Key;
+      pragma Test_Statement;
+   begin
+      I := Elems.all (1).all.Key;
+      pragma Test_Statement;
+   end Y;
+
+begin
+   null;
+end Test;