aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorYannick Moy <moy@adacore.com>2021-10-15 15:06:34 +0200
committerPierre-Marie de Rodat <derodat@adacore.com>2021-10-25 15:07:19 +0000
commit5145d173a85d9cc7afe351ce33639d559c344e9d (patch)
treea94d062a23988a46032adeb799a7027029730324
parentea5f7f3962a0781cfd36016776adf79986929bfa (diff)
downloadgcc-5145d173a85d9cc7afe351ce33639d559c344e9d.zip
gcc-5145d173a85d9cc7afe351ce33639d559c344e9d.tar.gz
gcc-5145d173a85d9cc7afe351ce33639d559c344e9d.tar.bz2
[Ada] Issue error on invalid use of Ghost inside pragma Predicate
gcc/ada/ * sem_ch13.adb (Freeze_Entity_Checks): Perform same check on predicate expression inside pragma as inside aspect. * sem_util.adb (Is_Current_Instance): Recognize possible occurrence of subtype as current instance inside the pragma Predicate.
-rw-r--r--gcc/ada/sem_ch13.adb22
-rw-r--r--gcc/ada/sem_util.adb6
2 files changed, 26 insertions, 2 deletions
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 3374e8b..0b9bce7 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -13144,6 +13144,28 @@ package body Sem_Ch13 is
else
Check_Aspect_At_Freeze_Point (Ritem);
end if;
+
+ -- A pragma Predicate should be checked like one of the
+ -- corresponding aspects, wrt possible misuse of ghost
+ -- entities.
+
+ elsif Nkind (Ritem) = N_Pragma
+ and then No (Corresponding_Aspect (Ritem))
+ and then
+ Get_Pragma_Id (Pragma_Name (Ritem)) = Pragma_Predicate
+ then
+ -- Retrieve the visibility to components and discriminants
+ -- in order to properly analyze the pragma.
+
+ declare
+ Arg : constant Node_Id :=
+ Next (First (Pragma_Argument_Associations (Ritem)));
+ begin
+ Push_Type (E);
+ Preanalyze_Spec_Expression
+ (Expression (Arg), Standard_Boolean);
+ Pop_Type (E);
+ end;
end if;
Next_Rep_Item (Ritem);
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index db4d55a..4dfee1e 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -16644,7 +16644,8 @@ package body Sem_Util is
-- Predicate_Failure aspect, for which we do not construct a
-- wrapper procedure. The subtype will be replaced by the
-- expression being tested when the corresponding predicate
- -- check is expanded.
+ -- check is expanded. It may also appear in the pragma Predicate
+ -- expression during legality checking.
elsif Nkind (P) = N_Aspect_Specification
and then Nkind (Parent (P)) = N_Subtype_Declaration
@@ -16652,7 +16653,8 @@ package body Sem_Util is
return True;
elsif Nkind (P) = N_Pragma
- and then Get_Pragma_Id (P) = Pragma_Predicate_Failure
+ and then Get_Pragma_Id (P) in Pragma_Predicate
+ | Pragma_Predicate_Failure
then
return True;
end if;