Fix is_task_type for derived types and subtypes

AdaCore · Nov 24, 2023 · 40665ee · 40665ee
1 parent 8eac42d
commit 40665ee
Show file tree

Hide file tree

Showing 4 changed files with 51 additions and 2 deletions.
diff --git a/ada/ast.py b/ada/ast.py
@@ -4882,7 +4882,7 @@ def is_tagged_type():
         """
         return False
 
-    is_task_type = Property(False)
+    is_task_type = Property(False, dynamic_vars=[default_origin()])
 
     is_limited_type = Property(False)
 
@@ -8878,6 +8878,7 @@ class DerivedTypeDef(TypeDef):
         Entity.interfaces.map(lambda i: i.name_designated_type)
     )
 
+    is_task_type = Property(Entity.base_type.is_task_type)
     is_int_type = Property(Entity.base_type.is_int_type)
     is_access_type = Property(Self.as_bare_entity.base_type.is_access_type)
     is_char_type = Property(Entity.base_type.is_char_type)
@@ -9310,6 +9311,7 @@ def get_type():
     canonical_type = Property(Entity.get_type.canonical_type)
     record_def = Property(Entity.get_type.record_def)
     accessed_type = Property(Entity.get_type.accessed_type)
+    is_task_type = Property(Entity.get_type.is_task_type)
     is_int_type = Property(Entity.get_type.is_int_type)
     is_discrete_type = Property(Entity.get_type.is_discrete_type)
 

diff --git a/testsuite/tests/name_resolution/abort_stmt/derived.adb b/testsuite/tests/name_resolution/abort_stmt/derived.adb
@@ -0,0 +1,27 @@
+procedure Derived is
+   task type T is
+   end T;
+
+   task body T is
+   begin
+      null;
+   end T;
+
+   subtype ST is T;
+   type NT is new T;
+
+   procedure Kill (X : ST) is
+   begin
+      abort X;
+      pragma Test_Statement;
+   end Kill;
+
+   procedure Kill (X : NT) is
+   begin
+      abort X;
+      pragma Test_Statement;
+   end Kill;
+
+begin
+   null;
+end Derived;
diff --git a/testsuite/tests/name_resolution/abort_stmt/test.out b/testsuite/tests/name_resolution/abort_stmt/test.out
@@ -18,4 +18,24 @@ Expr: <Id "T2" testabort.adb:38:10-38:12>
   expected type: None
 
 
+Analyzing derived.adb
+#####################
+
+Resolving xrefs for node <AbortStmt derived.adb:15:7-15:15>
+***********************************************************
+
+Expr: <Id "X" derived.adb:15:13-15:14>
+  references:    <DefiningName "X" derived.adb:13:20-13:21>
+  type:          <SubtypeDecl ["ST"] derived.adb:10:4-10:20>
+  expected type: None
+
+Resolving xrefs for node <AbortStmt derived.adb:21:7-21:15>
+***********************************************************
+
+Expr: <Id "X" derived.adb:21:13-21:14>
+  references:    <DefiningName "X" derived.adb:19:20-19:21>
+  type:          <ConcreteTypeDecl ["NT"] derived.adb:11:4-11:21>
+  expected type: None
+
+
 Done.
diff --git a/testsuite/tests/name_resolution/abort_stmt/test.yaml b/testsuite/tests/name_resolution/abort_stmt/test.yaml
@@ -1,2 +1,2 @@
 driver: name-resolution
-input_sources: [testabort.adb]
+input_sources: [testabort.adb, derived.adb]