aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada
diff options
context:
space:
mode:
authorEric Botcazou <ebotcazou@adacore.com>2023-09-28 15:53:36 +0200
committerMarc Poulhiès <poulhies@adacore.com>2023-12-19 15:27:51 +0100
commita3626f49d64c8b81aadae61ae4fad7d4d0f9d6b8 (patch)
tree86cc40e61a3f52f7f70d00cd9d349c1c1cdc385b /gcc/ada
parent257a2fca4f9fdf2f506b6d5a63109fb38baacce3 (diff)
downloadgcc-a3626f49d64c8b81aadae61ae4fad7d4d0f9d6b8.zip
gcc-a3626f49d64c8b81aadae61ae4fad7d4d0f9d6b8.tar.gz
gcc-a3626f49d64c8b81aadae61ae4fad7d4d0f9d6b8.tar.bz2
ada: Fix internal error on call with parameter of predicated subtype
The problem is that the predicated subtype does not inherit all the required attributes of a string subtype with a static predicate. gcc/ada/ * sem_ch3.adb (Analyze_Subtype_Declaration): Remove a short-circuit for subtypes without aspects when it comes to predicates. * sem_util.adb (Inherit_Predicate_Flags): Deal with private subtypes whose full view is an Itype.
Diffstat (limited to 'gcc/ada')
-rw-r--r--gcc/ada/sem_ch3.adb11
-rw-r--r--gcc/ada/sem_util.adb7
2 files changed, 8 insertions, 10 deletions
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 33d8f11..a6bc8c9 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -6032,17 +6032,10 @@ package body Sem_Ch3 is
-- If this is a subtype declaration for an actual in an instance,
-- inherit static and dynamic predicates if any.
- -- If declaration has no aspect specifications, inherit predicate
- -- info as well. Unclear how to handle the case of both specified
- -- and inherited predicates ??? Other inherited aspects, such as
- -- invariants, should be OK, but the combination with later pragmas
- -- may also require special merging.
-
if Has_Predicates (T)
and then Present (Predicate_Function (T))
- and then
- ((In_Instance and then not Comes_From_Source (N))
- or else No (Aspect_Specifications (N)))
+ and then In_Instance
+ and then not Comes_From_Source (N)
then
-- Inherit Subprograms_For_Type from the full view, if present
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 791fa7b..9cff9e1 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -14531,11 +14531,16 @@ package body Sem_Util is
-- A named subtype does not inherit the predicate function of its
-- parent but an itype declared for a loop index needs the discrete
-- predicate information of its parent to execute the loop properly.
+ -- Moreover, a named private subtype whose full view is an itype also
+ -- needs to inherit a predicate function because it will not be frozen.
-- A non-discrete type may has a static predicate (for example True)
-- but has no static_discrete_predicate.
if not Only_Flags
- and then Is_Itype (Subt)
+ and then (Is_Itype (Subt)
+ or else (Ekind (Subt) = E_Private_Subtype
+ and then Present (Full_View (Subt))
+ and then Is_Itype (Full_View (Subt))))
and then Present (Predicate_Function (Par))
then
Set_Subprograms_For_Type (Subt, Subprograms_For_Type (Par));