diff mbox series

[Ada] Enforce legality rule for Predicate_Failure aspect specifications

Message ID 20210921152604.GA3094581@adacore.com
State New
Headers show
Series [Ada] Enforce legality rule for Predicate_Failure aspect specifications | expand

Commit Message

Pierre-Marie de Rodat Sept. 21, 2021, 3:26 p.m. UTC 
If a Predicate_Failure aspect is specified for a type or subtype, Ada
requires that either the Static_Predicate aspect or the
Dynamic_Predicate aspect must also be specified for that same type or
subtype. [The GNAT-defined Predicate aspect can also be used to meet
this requirement.] The point is that an aspect inherited from some other
source does not meet this requirment.  Add enforcement of this legality
rule.

Tested on x86_64-pc-linux-gnu, committed on trunk

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 mbox series

Patch

diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
--- 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