procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

[Ada] Rewrite Sem_Eval.Predicates_Match predicate

Browse source 
2020-06-15  Eric Botcazou  <ebotcazou@adacore.com>

gcc/ada/

	* sem_eval.ads (Predicates_Match): Fix description.
	* sem_eval.adb (Predicates_Match): Rewrite.
This commit is contained in:
Eric Botcazou 2020-04-02 22:14:04 +02:00 • committed by Pierre-Marie de Rodat
parent e808ee00fb
commit 4331490bc0
2 changed files with 30 additions and 28 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

50
gcc/ada/sem_eval.adb
View file

@ -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 Has_Predicates (T1) /= Has_Predicates (T2) then
elsif not Has_Predicates (T2) then
return not Has_Predicates (T1);
-- T2 has predicates, no match if T1 has none
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;

8
gcc/ada/sem_eval.ads
View file

@ -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;