From: Steve Baird <baird@adacore.com>
Date: Fri, 2 Jul 2021 00:03:25 +0000 (-0700)
Subject: [Ada] Enforce legality rule for Predicate_Failure aspect specifications
X-Git-Tag: basepoints/gcc-13~4580
X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=e9068967876383bf0d9280b4f455fd50e7faf152;p=thirdparty%2Fgcc.git

[Ada] Enforce legality rule for Predicate_Failure aspect specifications

gcc/ada/

	* sem_ch13.adb (Analyze_Aspect_Specifications): Add a new nested
	function, Directly_Specified, and then use it in the
	implementation of the required check.
---

diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 0ac8bdccda4f..e841dda5c78e 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -1884,6 +1884,11 @@ package body Sem_Ch13 is
             --  expression is allowed. Includes checking that the expression
             --  does not raise Constraint_Error.
 
+            function Directly_Specified
+              (Id : Entity_Id; A : Aspect_Id) return Boolean;
+            --  Returns True if the given aspect is directly (as opposed to
+            --  via any form of inheritance) specified for the given entity.
+
             function Make_Aitem_Pragma
               (Pragma_Argument_Associations : List_Id;
                Pragma_Name                  : Name_Id) return Node_Id;
@@ -2777,6 +2782,18 @@ package body Sem_Ch13 is
                end if;
             end Check_Expr_Is_OK_Static_Expression;
 
+            ------------------------
+            -- Directly_Specified --
+            ------------------------
+
+            function Directly_Specified
+              (Id : Entity_Id; A : Aspect_Id) return Boolean
+            is
+               Aspect_Spec : constant Node_Id := Find_Aspect (Id, A);
+            begin
+               return Present (Aspect_Spec) and then Entity (Aspect_Spec) = Id;
+            end Directly_Specified;
+
             -----------------------
             -- Make_Aitem_Pragma --
             -----------------------
@@ -3342,6 +3359,15 @@ package body Sem_Ch13 is
                        ("Predicate_Failure requires previous predicate" &
                         " specification", Aspect);
                      goto Continue;
+
+                  elsif not (Directly_Specified (E, Aspect_Dynamic_Predicate)
+                    or else Directly_Specified (E, Aspect_Static_Predicate)
+                    or else Directly_Specified (E, Aspect_Predicate))
+                  then
+                     Error_Msg_N
+                       ("Predicate_Failure requires accompanying" &
+                        " noninherited predicate specification", Aspect);
+                     goto Continue;
                   end if;
 
                   --  Construct the pragma