[Ada] Rewrite Sem_Eval.Predicates_Match predicate
authorEric Botcazou <ebotcazou@adacore.com>
Thu, 2 Apr 2020 20:14:04 +0000 (22:14 +0200)
committerPierre-Marie de Rodat <derodat@adacore.com>
Mon, 15 Jun 2020 08:04:43 +0000 (04:04 -0400)
2020-06-15  Eric Botcazou  <ebotcazou@adacore.com>

gcc/ada/

* sem_eval.ads (Predicates_Match): Fix description.
* sem_eval.adb (Predicates_Match): Rewrite.

gcc/ada/sem_eval.adb
gcc/ada/sem_eval.ads

index f3c09f9181a0b4402560150d209f53d6dc5b98e3..85a819bf075f3c8a5d00dfabe288e59c7f3f3c1a 100644 (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 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;
 
index 984a75f952dc7dbe57eaacb4758bb13fd2ce730c..3bdbd4b177c249de42226fce2c644ba6791ef98c 100644 (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;