diff options
author | Eric Botcazou <ebotcazou@adacore.com> | 2020-04-02 22:14:04 +0200 |
---|---|---|
committer | Pierre-Marie de Rodat <derodat@adacore.com> | 2020-06-15 04:04:43 -0400 |
commit | 4331490bc0ef959062e46d8133ae943cf0a05209 (patch) | |
tree | b2c96e246f8d47c4db4a396157dfe1ef539f9d2f /gcc | |
parent | e808ee00fb66774de3d2caf77eb9933485b752a5 (diff) | |
download | gcc-4331490bc0ef959062e46d8133ae943cf0a05209.zip gcc-4331490bc0ef959062e46d8133ae943cf0a05209.tar.gz gcc-4331490bc0ef959062e46d8133ae943cf0a05209.tar.bz2 |
[Ada] Rewrite Sem_Eval.Predicates_Match predicate
2020-06-15 Eric Botcazou <ebotcazou@adacore.com>
gcc/ada/
* sem_eval.ads (Predicates_Match): Fix description.
* sem_eval.adb (Predicates_Match): Rewrite.
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/ada/sem_eval.adb | 50 | ||||
-rw-r--r-- | gcc/ada/sem_eval.ads | 8 |
2 files changed, 30 insertions, 28 deletions
diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index f3c09f9..85a819b 100644 --- a/gcc/ada/sem_eval.adb +++ b/gcc/ada/sem_eval.adb @@ -5621,40 +5621,42 @@ package body Sem_Eval is ---------------------- function Predicates_Match (T1, T2 : Entity_Id) return Boolean is - Pred1 : Node_Id; - Pred2 : Node_Id; + + function Have_Same_Rep_Item (Nam : Name_Id) return Boolean; + -- Return True if T1 and T2 have the same rep item for Nam + + ------------------------ + -- Have_Same_Rep_Item -- + ------------------------ + + function Have_Same_Rep_Item (Nam : Name_Id) return Boolean is + begin + return Get_Rep_Item (T1, Nam) = Get_Rep_Item (T2, Nam); + end Have_Same_Rep_Item; + + -- Start of processing for Predicates_Match begin if Ada_Version < Ada_2012 then return True; - -- Both types must have predicates or lack them + -- If T2 has no predicates, match if and only if T1 has none + + elsif not Has_Predicates (T2) then + return not Has_Predicates (T1); + + -- T2 has predicates, no match if T1 has none - elsif Has_Predicates (T1) /= Has_Predicates (T2) then + elsif not Has_Predicates (T1) then return False; - -- Check matching predicates + -- Both T2 and T1 have predicates, check that they all come + -- from the same declarations. else - Pred1 := - Get_Rep_Item - (T1, Name_Static_Predicate, Check_Parents => False); - Pred2 := - Get_Rep_Item - (T2, Name_Static_Predicate, Check_Parents => False); - - -- Subtypes statically match if the predicate comes from the - -- same declaration, which can only happen if one is a subtype - -- of the other and has no explicit predicate. - - -- Suppress warnings on order of actuals, which is otherwise - -- triggered by one of the two calls below. - - pragma Warnings (Off); - return Pred1 = Pred2 - or else (No (Pred1) and then Is_Subtype_Of (T1, T2)) - or else (No (Pred2) and then Is_Subtype_Of (T2, T1)); - pragma Warnings (On); + return Have_Same_Rep_Item (Name_Static_Predicate) + and then Have_Same_Rep_Item (Name_Dynamic_Predicate) + and then Have_Same_Rep_Item (Name_Predicate); end if; end Predicates_Match; diff --git a/gcc/ada/sem_eval.ads b/gcc/ada/sem_eval.ads index 984a75f..3bdbd4b 100644 --- a/gcc/ada/sem_eval.ads +++ b/gcc/ada/sem_eval.ads @@ -482,10 +482,10 @@ package Sem_Eval is -- then it returns False. function Predicates_Match (T1, T2 : Entity_Id) return Boolean; - -- In Ada 2012, subtypes statically match if their static predicates - -- match as well. This function performs the required check that - -- predicates match. Separated out from Subtypes_Statically_Match so - -- that it can be used in specializing error messages. + -- In Ada 2012, subtypes statically match if their predicates match as + -- as well. This function performs the required check that predicates + -- match. Separated out from Subtypes_Statically_Match so that it can + -- be used in specializing error messages. function Subtypes_Statically_Compatible (T1 : Entity_Id; |