From 4331490bc0ef959062e46d8133ae943cf0a05209 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Thu, 2 Apr 2020 22:14:04 +0200 Subject: [PATCH] [Ada] Rewrite Sem_Eval.Predicates_Match predicate 2020-06-15 Eric Botcazou gcc/ada/ * sem_eval.ads (Predicates_Match): Fix description. * sem_eval.adb (Predicates_Match): Rewrite. --- gcc/ada/sem_eval.adb | 50 ++++++++++++++++++++++++++------------------------ 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; -- 2.7.4