Implement the is_limited_type property.

ada/ast.py

@@ -4850,6 +4850,8 @@ def is_tagged_type():
 
     is_task_type = Property(False)
 
+    is_limited_type = Property(False)
+
     base_type = Property(
         No(T.BaseTypeDecl.entity), doc="""
         Return the base type entity for this derived type definition.
@@ -5332,6 +5334,22 @@ def shapes():
             ).singleton
         )
 
+    @langkit_property(return_type=Bool)
+    def has_limited_component():
+        """
+        Return whether this component list declares at least one component
+        which is limited. This also looks in all branches of a variant part.
+        """
+        return origin.bind(
+            No(AdaNode),
+            Entity.components.any(
+                lambda c:
+                c.cast(BaseFormalParamDecl)._.formal_type._.is_limited_type
+            ) | Entity.variant_part._.variant.any(
+                lambda v: v.components.has_limited_component
+            )
+        )
+
 
 @abstract
 class BaseRecordDef(AdaNode):
@@ -5480,6 +5498,10 @@ class RecordTypeDef(TypeDef):
     record_def = Field(type=T.BaseRecordDef)
 
     is_tagged_type = Property(Self.has_tagged.as_bool)
+    is_limited_type = Property(
+        Self.has_limited.as_bool
+        | Entity.record_def.comps.has_limited_component
+    )
 
     xref_equation = Property(LogicTrue())
 
@@ -6812,6 +6834,33 @@ def is_interface_type():
             lambda _: False
         )
 
+    @langkit_property(return_type=Bool, public=True)
+    def is_limited_type():
+        """
+        Return True iff this type is limited, either because it is explicitly
+        marked as such, or because it inherits from a limited type or has a
+        component of a limited type. Also note that protected types and task
+        types are limited by definition. Moreover, note that Ada requires
+        all parts of a type to agree of its limitedness (e.g. the public view
+        of a type must indicate that it is limited if its private completion
+        ends up being limited), hence this property does not require looking at
+        any other part of the type to determine its limitedness, excepted for
+        incomplete type declarations. This implies that for illegal code where
+        several parts don't agree, this property will return the result for the
+        particular view of the type on which this property is called.
+        """
+        # This property does not require an "origin" parameter because as
+        # explained above, all parts of a type must agree on the fact that the
+        # type is limited or not.
+        return Entity.match(
+            lambda td=TypeDecl: td.type_def.is_limited_type,
+            lambda sb=SubtypeDecl: sb.get_type.is_limited_type,
+            lambda it=IncompleteTypeDecl: it.full_view.is_limited_type,
+            lambda _=ProtectedTypeDecl: True,
+            lambda _=TaskTypeDecl: True,
+            lambda _: False
+        )
+
     @langkit_property(dynamic_vars=[origin])
     def iterable_comp_type():
         return No(T.BaseTypeDecl.entity)
@@ -8665,6 +8714,19 @@ class DerivedTypeDef(TypeDef):
     )
 
     is_enum_type = Property(Entity.base_type.is_enum_type)
+    is_limited_type = Property(
+        Self.has_limited.as_bool
+        | Entity.record_extension._.comps._.has_limited_component
+        | origin.bind(
+            No(AdaNode),  # We want full visibility
+            # Note that we don't recurse on interfaces, because limitedness is
+            # not inherited from those (ARM 7.5 6.2/2).
+            Entity.base_type.then(
+                lambda bt: Not(bt.is_interface_type) & bt.is_limited_type
+            )
+        )
+    )
+
     is_static = Property(Entity.subtype_indication.is_static_subtype)
 
     @langkit_property(return_type=Equation)
@@ -8694,6 +8756,7 @@ class PrivateTypeDef(TypeDef):
     has_limited = Field(type=Limited)
 
     is_tagged_type = Property(Self.has_tagged.as_bool)
+    is_limited_type = Property(Self.has_limited.as_bool)
 
     xref_equation = Property(LogicTrue())
 
@@ -8951,6 +9014,11 @@ def index_type(dim=Int):
 
     array_ndims = Property(Self.indices.ndims)
 
+    is_limited_type = Property(origin.bind(
+        No(AdaNode),  # We want full visibility
+        Entity.comp_type.is_limited_type
+    ))
+
     @langkit_property()
     def xref_equation():
         return And(
@@ -9022,6 +9090,10 @@ class InterfaceTypeDef(TypeDef):
     is_tagged_type = Property(True)
     is_task_type = Property(Entity.interface_kind.is_a(InterfaceKind.alt_task))
 
+    # All four interface kinds declare limited types. Also, limitedness is not
+    # inherited from parent interfaces (ARM 7.5 6.2/2).
+    is_limited_type = Property(Not(Self.interface_kind.is_null))
+
     base_interfaces = Property(
         Entity.interfaces.map(lambda i: i.name_designated_type)
     )

testsuite/tests/properties/is_limited_type/test.adb

@@ -0,0 +1,52 @@
+procedure Test is
+   type Non_Limited is range 1 .. 10;
+   --% node.p_is_limited_type
+
+   type Limited_Null_Rec is limited null record;
+   --% node.p_is_limited_type
+
+   type Limited_Array is array (Positive range <>) of Limited_Null_Rec;
+   --% node.p_is_limited_type
+
+   type Limited_Derived_Type is new Limited_Null_Rec;
+   --% node.p_is_limited_type
+
+   type Limited_Tagged_Rec is tagged limited null record;
+   --% node.p_is_limited_type
+
+   type Limited_Derived_Tagged_Type is new Limited_Tagged_Rec with null record;
+   --% node.p_is_limited_type
+
+   type Limited_Component_Type is record
+      X : Limited_Null_Rec;
+   end record;
+   --% node.p_is_limited_type
+
+   type Limited_Variant_Type (K : Boolean) is record
+      case K is
+         when True =>
+            X : Limited_Null_Rec;
+         when False =>
+            Y : Integer;
+      end case;
+   end record;
+   --% node.p_is_limited_type
+
+   type Non_Limited_Interface is interface;
+   --% node.p_is_limited_type
+
+   type Limited_Synchronized_Interface is synchronized interface;
+   --% node.p_is_limited_type
+
+   type Limited_Interface is limited interface;
+   --% node.p_is_limited_type
+
+   type Non_Limited_Derived_Interface is interface and Limited_Interface;
+   --% node.p_is_limited_type
+
+   type Non_Limited_From_Limited_Interface is new Limited_Interface
+      with null record;
+   --% node.p_is_limited_type
+begin
+   null;
+end Test;

testsuite/tests/properties/is_limited_type/test.out

@@ -0,0 +1,77 @@
+Working on node <ConcreteTypeDecl ["Non_Limited"] test.adb:2:4-2:38>
+====================================================================
+
+Eval 'node.p_is_limited_type'
+Result: False
+
+Working on node <ConcreteTypeDecl ["Limited_Null_Rec"] test.adb:5:4-5:49>
+=========================================================================
+
+Eval 'node.p_is_limited_type'
+Result: True
+
+Working on node <ConcreteTypeDecl ["Limited_Array"] test.adb:8:4-8:72>
+======================================================================
+
+Eval 'node.p_is_limited_type'
+Result: True
+
+Working on node <ConcreteTypeDecl ["Limited_Derived_Type"] test.adb:11:4-11:54>
+===============================================================================
+
+Eval 'node.p_is_limited_type'
+Result: True
+
+Working on node <ConcreteTypeDecl ["Limited_Tagged_Rec"] test.adb:14:4-14:58>
+=============================================================================
+
+Eval 'node.p_is_limited_type'
+Result: True
+
+Working on node <ConcreteTypeDecl ["Limited_Derived_Tagged_Type"] test.adb:17:4-17:80>
+======================================================================================
+
+Eval 'node.p_is_limited_type'
+Result: True
+
+Working on node <ConcreteTypeDecl ["Limited_Component_Type"] test.adb:20:4-22:15>
+=================================================================================
+
+Eval 'node.p_is_limited_type'
+Result: True
+
+Working on node <ConcreteTypeDecl ["Limited_Variant_Type"] test.adb:25:4-32:15>
+===============================================================================
+
+Eval 'node.p_is_limited_type'
+Result: True
+
+Working on node <ConcreteTypeDecl ["Non_Limited_Interface"] test.adb:35:4-35:44>
+================================================================================
+
+Eval 'node.p_is_limited_type'
+Result: False
+
+Working on node <ConcreteTypeDecl ["Limited_Synchronized_Interface"] test.adb:38:4-38:66>
+=========================================================================================
+
+Eval 'node.p_is_limited_type'
+Result: True
+
+Working on node <ConcreteTypeDecl ["Limited_Interface"] test.adb:41:4-41:48>
+============================================================================
+
+Eval 'node.p_is_limited_type'
+Result: True
+
+Working on node <ConcreteTypeDecl ["Non_Limited_Derived_Interface"] test.adb:44:4-44:74>
+========================================================================================
+
+Eval 'node.p_is_limited_type'
+Result: False
+
+Working on node <ConcreteTypeDecl ["Non_Limited_From_Limited_Interface"] test.adb:47:4-48:24>
+=============================================================================================
+
+Eval 'node.p_is_limited_type'
+Result: False

testsuite/tests/properties/is_limited_type/test.yaml

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

user_manual/changes/1106.yaml

@@ -0,0 +1,7 @@
+type: new-feature
+title: Add ``p_is_limited_type`` property
+description: |
+  This new property returns whether the given ``BaseTypeDecl`` node is a
+  limited type or not, either because it is explicitly marked as such, or
+  because it inherits from a limited type or has a component of a limited type.
+date: 2023-10-13