From 25115122fe88806451c9886cf53ed89ab053ce1e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Rapha=C3=ABl=20AMIARD?= <amiard@adacore.com>
Date: Tue, 16 Apr 2024 11:03:25 +0200
Subject: [PATCH] Extend is_definite_subtype to work on type expressions

---
 ada/ast.py                                         | 14 ++++++++++++++
 .../tests/properties/is_definite_subtype/test.adb  | 12 ++++++++++++
 .../tests/properties/is_definite_subtype/test.out  |  5 +++++
 .../tests/properties/is_definite_subtype/test.py   |  7 +++++++
 4 files changed, 38 insertions(+)

diff --git a/ada/ast.py b/ada/ast.py
index 6b7e84c4f..ffa3355fa 100644
--- a/ada/ast.py
+++ b/ada/ast.py
@@ -10484,6 +10484,13 @@ class TypeExpr(AdaNode):
     This node has no ARM correspondence.
     """
 
+    @langkit_property(public=True)
+    def is_definite_subtype():
+        """
+        Returns whether this designates a definite subtype.
+        """
+        return Entity.designated_type_decl.is_definite_subtype
+
     array_ndims = Property(
         origin.bind(Self.origin_node, Entity.designated_type.array_ndims)
     )
@@ -10643,6 +10650,13 @@ class SubtypeIndication(TypeExpr):
         env.bind(Entity.node_env, Entity.name.designated_type_impl)
     )
 
+    @langkit_property()
+    def is_definite_subtype():
+        return (
+            Not(Entity.constraint.is_null)
+            | Entity.designated_type_decl.is_definite_subtype
+        )
+
     @langkit_property(return_type=T.CompletionItem.array)
     def complete_items():
         """
diff --git a/testsuite/tests/properties/is_definite_subtype/test.adb b/testsuite/tests/properties/is_definite_subtype/test.adb
index 25a358191..7132da7cd 100644
--- a/testsuite/tests/properties/is_definite_subtype/test.adb
+++ b/testsuite/tests/properties/is_definite_subtype/test.adb
@@ -6,6 +6,18 @@ procedure Test is
    type C is array (Integer) of Natural;
    type CC is array (Integer range <>) of Integer;
    type D is new CC (1 .. 12);
+
+   type E (A : Boolean) is record
+      case A is
+         when True => B : Integer;
+         when False => null;
+      end case;
+   end record;
+
+   O1 : CC := (1, 2, 3, 4);
+   O2 : CC (1 .. 10);
+   O3 : E (True);
+   O4 : E := (A => True, others => <>);
 begin
    null;
 end Test;
diff --git a/testsuite/tests/properties/is_definite_subtype/test.out b/testsuite/tests/properties/is_definite_subtype/test.out
index 23bfb3ae8..60c30ee4d 100644
--- a/testsuite/tests/properties/is_definite_subtype/test.out
+++ b/testsuite/tests/properties/is_definite_subtype/test.out
@@ -6,5 +6,10 @@
 <ConcreteTypeDecl ["C"] test.adb:6:4-6:41> is a definite subtype
 <ConcreteTypeDecl ["CC"] test.adb:7:4-7:51> is not a definite subtype
 <ConcreteTypeDecl ["D"] test.adb:8:4-8:31> is a definite subtype
+<ConcreteTypeDecl ["E"] test.adb:10:4-15:15> is not a definite subtype
+<SubtypeIndication test.adb:17:9-17:11> is not a definite subtype
+<SubtypeIndication test.adb:18:9-18:21> is a definite subtype
+<SubtypeIndication test.adb:19:9-19:17> is a definite subtype
+<SubtypeIndication test.adb:20:9-20:10> is not a definite subtype
 
 Done
diff --git a/testsuite/tests/properties/is_definite_subtype/test.py b/testsuite/tests/properties/is_definite_subtype/test.py
index 5b21d1482..1e746be99 100644
--- a/testsuite/tests/properties/is_definite_subtype/test.py
+++ b/testsuite/tests/properties/is_definite_subtype/test.py
@@ -14,6 +14,13 @@
         else:
             print('{} is not a definite subtype'.format(n))
 
+    for n in u.root.findall(lal.ObjectDecl):
+        te = n.f_type_expr
+        if te.p_is_definite_subtype:
+            print('{} is a definite subtype'.format(te))
+        else:
+            print('{} is not a definite subtype'.format(te))
+
     print('')
 
 print('Done')