https://gcc.gnu.org/g:bf941670685fd8d646ae8955c3bb086d1512bac2
commit r15-662-gbf941670685fd8d646ae8955c3bb086d1512bac2
Author: Jose Ruiz <r...@adacore.com>
Date: Thu Mar 7 11:20:03 2024 +0100
ada: Implement representation aspect Max_Entry_Queue_Length
Enforce Max_Entry_Queue_Length (and its
synonym Max_Entry_Queue_Depth) when applied to individual
protected entries.
gcc/ada/
* exp_ch9.adb (Expand_N_Protected_Type_Declaration): Clarify
comments.
* sem_prag.adb (Analyze_Pragma): Check for duplicates
Max_Entry_Queue_Length, Max_Entry_Queue_Depth and Max_Queue_Length
for the same protected entry.
* sem_util.adb (Get_Max_Queue_Length): Take into account all three
representation aspects that can be used to set this restriction.
(Has_Max_Queue_Length): Likewise.
* doc/gnat_rm/implementation_defined_pragmas.rst:
(pragma Max_Queue_Length): Fix pragma in example.
* gnat_rm.texi: Regenerate.
Diff:
---
.../doc/gnat_rm/implementation_defined_pragmas.rst | 2 +-
gcc/ada/exp_ch9.adb | 6 ++--
gcc/ada/gnat_rm.texi | 2 +-
gcc/ada/sem_prag.adb | 11 ++++++++
gcc/ada/sem_util.adb | 33 ++++++++++++++++------
5 files changed, 41 insertions(+), 13 deletions(-)
diff --git a/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst
b/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst
index bcbd85984dc0..0661670e0475 100644
--- a/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst
+++ b/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst
@@ -3771,7 +3771,7 @@ Pragma Max_Queue_Length
Syntax::
- pragma Max_Entry_Queue (static_integer_EXPRESSION);
+ pragma Max_Queue_Length (static_integer_EXPRESSION);
This pragma is used to specify the maximum callers per entry queue for
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index 051b1df060f8..4de253ab6e83 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -9405,7 +9405,8 @@ package body Exp_Ch9 is
end loop;
-- Create the declaration of an array object which contains the values
- -- of aspect/pragma Max_Queue_Length for all entries of the protected
+ -- of any aspect/pragma Max_Queue_Length, Max_Entry_Queue_Length or
+ -- Max_EntryQueue_Depth for all entries of the protected
-- type. This object is later passed to the appropriate protected object
-- initialization routine.
@@ -9422,7 +9423,8 @@ package body Exp_Ch9 is
Need_Array : Boolean := False;
begin
- -- First check if there is any Max_Queue_Length pragma
+ -- First check if there is any Max_Queue_Length,
+ -- Max_Entry_Queue_Length or Max_Entry_Queue_Depth pragma.
Item := First_Entity (Prot_Typ);
while Present (Item) loop
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index 40516121b7ab..4dbbb036a259 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -5312,7 +5312,7 @@ no effect in GNAT, other than being syntax checked.
Syntax:
@example
-pragma Max_Entry_Queue (static_integer_EXPRESSION);
+pragma Max_Queue_Length (static_integer_EXPRESSION);
@end example
This pragma is used to specify the maximum callers per entry queue for
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index f27e40edcbbf..0e2ce9de4b53 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -20388,6 +20388,17 @@ package body Sem_Prag is
("pragma % must apply to a protected entry declaration");
end if;
+ -- Check for duplicates
+
+ if Has_Rep_Pragma (Entry_Id, Name_Max_Entry_Queue_Length)
+ or else
+ Has_Rep_Pragma (Entry_Id, Name_Max_Entry_Queue_Depth)
+ or else
+ Has_Rep_Pragma (Entry_Id, Name_Max_Queue_Length)
+ then
+ Error_Msg_N ("??duplicate Max_Entry_Queue_Length pragma", N);
+ end if;
+
-- Mark the pragma as Ghost if the related subprogram is also
-- Ghost. This also ensures that any expansion performed further
-- below will produce Ghost nodes.
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index d512d462b443..09358278210e 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -10714,26 +10714,38 @@ package body Sem_Util is
function Get_Max_Queue_Length (Id : Entity_Id) return Uint is
pragma Assert (Is_Entry (Id));
- Prag : constant Entity_Id := Get_Pragma (Id, Pragma_Max_Queue_Length);
- Max : Uint;
+ PMQL : constant Entity_Id := Get_Pragma (Id, Pragma_Max_Queue_Length);
+ PMEQD : constant Entity_Id :=
+ Get_Pragma (Id, Pragma_Max_Entry_Queue_Depth);
+ PMEQL : constant Entity_Id :=
+ Get_Pragma (Id, Pragma_Max_Entry_Queue_Length);
+ Max : Uint;
begin
-- A value of 0 or -1 represents no maximum specified, and entries and
-- entry families with no Max_Queue_Length aspect or pragma default to
-- it.
- if No (Prag) then
- return Uint_0;
+ -- We have already checked that there is at most one of these pragmas
+
+ if Present (PMQL) then
+ Max := Expr_Value
+ (Expression (First (Pragma_Argument_Associations (PMQL))));
+ elsif Present (PMEQD) then
+ Max := Expr_Value
+ (Expression (First (Pragma_Argument_Associations (PMEQD))));
+ elsif Present (PMEQL) then
+ Max := Expr_Value
+ (Expression (First (Pragma_Argument_Associations (PMEQL))));
+ else
+ Max := Uint_0;
end if;
- Max := Expr_Value
- (Expression (First (Pragma_Argument_Associations (Prag))));
-
-- Since -1 and 0 are equivalent, return 0 for instances of -1 for
-- uniformity.
if Max = -1 then
- return Uint_0;
+ Max := Uint_0;
end if;
return Max;
@@ -12217,7 +12229,10 @@ package body Sem_Util is
begin
return
Ekind (Id) = E_Entry
- and then Present (Get_Pragma (Id, Pragma_Max_Queue_Length));
+ and then
+ (Present (Get_Pragma (Id, Pragma_Max_Queue_Length)) or else
+ Present (Get_Pragma (Id, Pragma_Max_Entry_Queue_Depth)) or else
+ Present (Get_Pragma (Id, Pragma_Max_Entry_Queue_Length)));
end Has_Max_Queue_Length;
---------------------------------
