diff options
author | Ed Schonberg <schonberg@adacore.com> | 2020-10-16 14:25:03 -0400 |
---|---|---|
committer | Pierre-Marie de Rodat <derodat@adacore.com> | 2020-11-25 08:22:46 -0500 |
commit | 55fae09dcb8257c8f4be90198f675aafe4ed8f9c (patch) | |
tree | 7aa320502e17a4d5b5d43a8605230ad49216fdad /gcc/ada/sem_eval.adb | |
parent | 57966b4d2f8adaf0d9af12e07a8ee32cd4184bcc (diff) | |
download | gcc-55fae09dcb8257c8f4be90198f675aafe4ed8f9c.zip gcc-55fae09dcb8257c8f4be90198f675aafe4ed8f9c.tar.gz gcc-55fae09dcb8257c8f4be90198f675aafe4ed8f9c.tar.bz2 |
[Ada] Spurious error on instance with predicated actual
gcc/ada/
* sem_eval.adb (Subtypes_Statically_Compatible): Scalar types
with compatible static bounds are statically compatible if
predicates are compatible, even if they are not static subtypes.
Same for private types without discriminants.
Diffstat (limited to 'gcc/ada/sem_eval.adb')
-rw-r--r-- | gcc/ada/sem_eval.adb | 18 |
1 files changed, 14 insertions, 4 deletions
diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index 52aa8c1..443926f 100644 --- a/gcc/ada/sem_eval.adb +++ b/gcc/ada/sem_eval.adb @@ -6311,11 +6311,13 @@ package body Sem_Eval is if Subtypes_Statically_Match (T1, T2) then return True; - -- If either subtype is nonstatic then they're not compatible + -- A scalar subtype S1 is compatible with S2 if their bounds + -- are static and compatible, even if S1 has dynamic predicates + -- and is thus non-static. Predicate compatibility has been + -- checked above. - elsif not Is_OK_Static_Subtype (T1) - or else - not Is_OK_Static_Subtype (T2) + elsif not Is_Static_Range (Scalar_Range (T1)) + or else not Is_Static_Range (Scalar_Range (T2)) then return False; @@ -6363,6 +6365,14 @@ package body Sem_Eval is and then not (Can_Never_Be_Null (T2) and then not Can_Never_Be_Null (T1)); + -- Private types without discriminants can be handled specially. + -- Predicate matching has been checked above. + + elsif Is_Private_Type (T1) + and then not Has_Discriminants (T1) + then + return not Has_Discriminants (T2); + -- All other cases else |