Make get_primitives working on task types

ada/ast.py

@@ -6357,6 +6357,10 @@ def get_enum_representation_clause():
             )
         ).cast(T.EnumRepClause.entity)
 
+    @langkit_property()
+    def parent_primitives_env():
+        return Self.empty_env
+
     @lazy_field(return_type=T.inner_env_assoc.array)
     def direct_primitive_subps():
         """
@@ -6365,7 +6369,8 @@ def direct_primitive_subps():
         package this type is declared in.
         """
         scope = Var(Self.declarative_scope)
-        is_derived_tagged = Var(Self.as_bare_entity.is_derived_tagged_type)
+        is_derived_tagged = Var(Self.as_bare_entity.cast(TypeDecl)
+                                ._.is_derived_tagged_type)
         decl_parts = Var(scope._.parent.as_bare_entity._.match(
             lambda pkg_decl=BasePackageDecl:
             # Self is declared in a package scope, we should check all the
@@ -6385,7 +6390,7 @@ def direct_primitive_subps():
                 No(AdaNode.entity.array)
             )
         ))
-        enum_lits = Var(Self.type_def.cast(EnumTypeDef).then(
+        enum_lits = Var(Self.cast(TypeDecl)._.type_def.cast(EnumTypeDef).then(
             lambda etf: etf.enum_literals.map(
                 lambda lit: T.inner_env_assoc.new(
                     key=lit.name.name_symbol,
@@ -6439,7 +6444,7 @@ def direct_primitive_subps():
         ))
 
         # Also add this types' predefined operators to the list of primitives
-        predefined_ops = Var(Self.predefined_operators.map(
+        predefined_ops = Var(Self.cast(TypeDecl)._.predefined_operators.map(
             lambda assoc: T.inner_env_assoc.new(
                 key=assoc.key,
                 value=assoc.value,
@@ -6475,7 +6480,7 @@ def own_primitives_envs(with_rebindings=T.EnvRebindings):
 
     @langkit_property(return_type=LexicalEnv.array)
     def primitives_envs(with_rebindings=T.EnvRebindings,
-                        stop_at=BaseTypeDecl.entity.array,
+                        stop_at=T.BaseTypeDecl.entity.array,
                         include_self=(Bool, False)):
         """
         Return the environments containing the primitives for Self (if
@@ -6488,6 +6493,7 @@ def primitives_envs(with_rebindings=T.EnvRebindings,
         # later.
         return origin.bind(Self, Entity.base_types.mapcat(lambda t: t.match(
             lambda td=T.TypeDecl: td,
+            lambda ttd=T.TaskTypeDecl: ttd,
             lambda std=T.BaseSubtypeDecl: origin.bind(
                 std.node.origin_node, std.get_type.cast(T.TypeDecl)
             ),
@@ -6508,7 +6514,7 @@ def primitives_envs(with_rebindings=T.EnvRebindings,
     @langkit_property(memoized=True)
     def compute_primitives_env(
         include_self=(Bool, True),
-        stop_at=(BaseTypeDecl.entity.array, No(BaseTypeDecl.entity.array))
+        stop_at=(T.BaseTypeDecl.entity.array, No(T.BaseTypeDecl.entity.array))
     ):
         """
         Return a environment containing all primitives accessible to Self,
@@ -6529,7 +6535,7 @@ def direct_primitives_env():
         primitives of this type, that is, primitives that are not inherited.
         """
         return DynamicLexicalEnv(
-            assocs_getter=TypeDecl.direct_primitive_subps,
+            assocs_getter=BaseTypeDecl.direct_primitive_subps,
             transitive_parent=False
         )
 
@@ -8251,6 +8257,10 @@ def defining_env():
             self_env,
         )
 
+    @langkit_property(memoized=True)
+    def primitives_env():
+        return Entity.compute_primitives_env(include_self=True)
+
     @langkit_property(return_type=T.env_assoc.array, memoized=True)
     def predefined_operators():
         """
@@ -8356,10 +8366,6 @@ def refined_parent_primitives_env():
             stop_at=Entity.previous_part._.base_types
         )
 
-    @langkit_property()
-    def primitives_env():
-        return Entity.compute_primitives_env(include_self=True)
-
     get_imp_deref = Property(
         Entity.get_aspect_spec_expr('Implicit_Dereference')
     )
@@ -9582,7 +9588,7 @@ class TaskTypeDecl(BaseTypeDecl):
     is_task_type = Property(True)
 
     base_interfaces = Property(
-        Entity.definition.interfaces.map(lambda i: i.name_designated_type)
+        Entity.definition._.interfaces.map(lambda i: i.name_designated_type)
     )
 
     @langkit_property(return_type=T.Symbol.array)
@@ -9598,6 +9604,10 @@ def env_names():
 
     defining_env = Property(Entity.children_env)
 
+    @langkit_property(memoized=True)
+    def primitives_env():
+        return Entity.compute_primitives_env(include_self=True)
+
     @langkit_property()
     def discriminants_list(
             stop_recurse_at=(T.BaseTypeDecl.entity, No(T.BaseTypeDecl.entity))

testsuite/tests/name_resolution/task_primitive/ptask.adb

@@ -0,0 +1,29 @@
+procedure Ptask is
+   package Pkg is
+      task type Parent is
+         entry E (I : in out Integer);
+      end Parent;
+
+      function Id (X : Parent) return Integer;
+   end Pkg;
+
+   use Pkg;
+
+   type T is new Parent;
+
+   X : T;
+
+   package body Pkg is
+      task body Parent is
+      begin
+         null;
+      end Parent;
+
+      function Id (X : Parent) return Integer is (4);
+   end pkg;
+
+   I : Integer := 8;
+begin
+   I := Id (X);
+   pragma Test_Statement;
+end Ptask;

testsuite/tests/name_resolution/task_primitive/test.out

@@ -0,0 +1,25 @@
+Analyzing ptask.adb
+###################
+
+Resolving xrefs for node <AssignStmt ptask.adb:27:4-27:16>
+**********************************************************
+
+Expr: <Id "I" ptask.adb:27:4-27:5>
+  references:    <DefiningName "I" ptask.adb:25:4-25:5>
+  type:          <ConcreteTypeDecl ["Integer"] __standard:4:3-4:54>
+  expected type: None
+Expr: <CallExpr ptask.adb:27:9-27:15>
+  references:    <DefiningName "Id" ptask.adb:7:16-7:18>
+  type:          <ConcreteTypeDecl ["Integer"] __standard:4:3-4:54>
+  expected type: <ConcreteTypeDecl ["Integer"] __standard:4:3-4:54>
+Expr: <Id "Id" ptask.adb:27:9-27:11>
+  references:    <DefiningName "Id" ptask.adb:7:16-7:18>
+  type:          <ConcreteTypeDecl ["Integer"] __standard:4:3-4:54>
+  expected type: None
+Expr: <Id "X" ptask.adb:27:13-27:14>
+  references:    <DefiningName "X" ptask.adb:14:4-14:5>
+  type:          <ConcreteTypeDecl ["T"] ptask.adb:12:4-12:25>
+  expected type: <ConcreteTypeDecl ["T"] ptask.adb:12:4-12:25>
+
+
+Done.

testsuite/tests/name_resolution/task_primitive/test.yaml

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

testsuite/tests/properties/get_primitives/ptask.adb

@@ -0,0 +1,29 @@
+procedure Ptask is
+   package Pkg is
+      task type Parent is
+         entry E (I : in out Integer);
+      end Parent;
+      --% node.p_get_primitives()
+
+      function Id (X : Parent) return Integer;
+   end Pkg;
+
+   use Pkg;
+
+   type T is new Parent;
+   --% node.p_get_primitives()
+
+   X : T;
+
+   package body Pkg is
+      task body Parent is
+      begin
+         null;
+      end Parent;
+
+      function Id (X : Parent) return Integer is (4);
+   end pkg;
+
+begin
+   null;
+end Ptask;

testsuite/tests/properties/get_primitives/test.out

@@ -1,3 +1,15 @@
+Working on node <TaskTypeDecl ["Parent"] ptask.adb:3:7-5:18>
+============================================================
+
+Eval 'node.p_get_primitives()'
+Result: [<SubpDecl ["Id"] ptask.adb:8:7-8:47>]
+
+Working on node <ConcreteTypeDecl ["T"] ptask.adb:13:4-13:25>
+=============================================================
+
+Eval 'node.p_get_primitives()'
+Result: [<SubpDecl ["Id"] ptask.adb:8:7-8:47>]
+
 Working on node <ConcreteTypeDecl ["I_5_7"] test.adb:19:4-19:42>
 ================================================================
 

testsuite/tests/properties/get_primitives/test.yaml

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

user_manual/changes/libadalang/1083.yaml

@@ -0,0 +1,8 @@
+type: api-change
+title: Move P_Get_Primitives from Type_Decl to Base_Type_Decl
+short_title: Move P_Get_Primitives in Base_Type_Decl
+description: |
+  This change moves the `P_Get_Primitives` from the `Ada_Type_Decl` type to
+  the `Ada_Base_Type_Decl` type. This allows to call `P_Get_Primitives` on
+  the `Ada_Task_Type_Decl` type for example.
+date: 2023-10-26