From 8b6ce166bbfe8d823f9b12a27a4941e3c169a3f1 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Rapha=C3=ABl=20AMIARD?= <raph.amiard@gmail.com>
Date: Fri, 7 Apr 2023 12:14:38 +0200
Subject: [PATCH] Fix specific_type in case of discrete base subtype

---
 ada/ast.py                                         | 7 ++++++-
 testsuite/tests/properties/specific_type/test.adb  | 6 ++++++
 testsuite/tests/properties/specific_type/test.out  | 5 +++++
 testsuite/tests/properties/specific_type/test.yaml | 2 ++
 4 files changed, 19 insertions(+), 1 deletion(-)
 create mode 100644 testsuite/tests/properties/specific_type/test.adb
 create mode 100644 testsuite/tests/properties/specific_type/test.out
 create mode 100644 testsuite/tests/properties/specific_type/test.yaml

diff --git a/ada/ast.py b/ada/ast.py
index 54aa0e900..a9e62f3ab 100644
--- a/ada/ast.py
+++ b/ada/ast.py
@@ -6132,7 +6132,12 @@ def specific_type():
             # Recurse on the class-wide type because it could be a subtype
             # renaming a class-wide type itself.
             lambda cw=T.ClasswideTypeDecl: cw.type_decl.specific_type,
-            lambda bt=T.BaseSubtypeDecl: bt.base_subtype.specific_type,
+            lambda bt=T.BaseSubtypeDecl: Let(
+                lambda bt=bt.base_subtype:
+                # Check if the base subtype is Self, to not do an infinite
+                # recursion.
+                If(bt == Entity, Entity, bt.specific_type)
+            ),
             lambda _: Entity
         )
 
diff --git a/testsuite/tests/properties/specific_type/test.adb b/testsuite/tests/properties/specific_type/test.adb
new file mode 100644
index 000000000..f824584f8
--- /dev/null
+++ b/testsuite/tests/properties/specific_type/test.adb
@@ -0,0 +1,6 @@
+procedure Test is
+   subtype P is Integer'Base;
+   --% node.f_subtype.p_designated_type_decl.p_specific_type
+begin
+   null;
+end Test;
diff --git a/testsuite/tests/properties/specific_type/test.out b/testsuite/tests/properties/specific_type/test.out
new file mode 100644
index 000000000..b6ec258f3
--- /dev/null
+++ b/testsuite/tests/properties/specific_type/test.out
@@ -0,0 +1,5 @@
+Working on node <SubtypeDecl ["P"] test.adb:2:4-2:30>
+=====================================================
+
+Eval 'node.f_subtype.p_designated_type_decl.p_specific_type'
+Result: <DiscreteBaseSubtypeDecl ["Integer"] __standard:4:3-4:54>
diff --git a/testsuite/tests/properties/specific_type/test.yaml b/testsuite/tests/properties/specific_type/test.yaml
new file mode 100644
index 000000000..35ad4d5c4
--- /dev/null
+++ b/testsuite/tests/properties/specific_type/test.yaml
@@ -0,0 +1,2 @@
+driver: inline-playground
+input_sources: [test.adb]