diff options
| author | Steve Baird <baird@adacore.com> | 2021-07-01 17:03:25 -0700 |
|---|---|---|
| committer | Pierre-Marie de Rodat <derodat@adacore.com> | 2021-09-21 15:24:56 +0000 |
| commit | e9068967876383bf0d9280b4f455fd50e7faf152 (patch) | |
| tree | 8fb655bd540d6d61f1c8d43da5ab80f821f9c75a /gcc/ada | |
| parent | 3598c8db4045d17705f845561517f74bf877a2e4 (diff) | |
| download | gcc-e9068967876383bf0d9280b4f455fd50e7faf152.zip gcc-e9068967876383bf0d9280b4f455fd50e7faf152.tar.gz gcc-e9068967876383bf0d9280b4f455fd50e7faf152.tar.bz2 | |
[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.
Diffstat (limited to 'gcc/ada')
| -rw-r--r-- | gcc/ada/sem_ch13.adb | 26 |
1 files changed, 26 insertions, 0 deletions
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 0ac8bdc..e841dda 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 |