public inbox for gcc-patches@gcc.gnu.org
 help / color / mirror / Atom feed
From: "Marc Poulhiès" <poulhies@adacore.com>
To: gcc-patches@gcc.gnu.org
Cc: Jose Ruiz <ruiz@adacore.com>
Subject: [COMMITTED 03/30] ada: Implement representation aspect Max_Entry_Queue_Length
Date: Mon, 20 May 2024 09:48:29 +0200	[thread overview]
Message-ID: <20240520074858.222435-3-poulhies@adacore.com> (raw)
In-Reply-To: <20240520074858.222435-1-poulhies@adacore.com>

From: Jose Ruiz <ruiz@adacore.com>

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.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 .../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 bcbd85984dc..0661670e047 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 051b1df060f..4de253ab6e8 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 40516121b7a..4dbbb036a25 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 f27e40edcbb..0e2ce9de4b5 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 d512d462b44..09358278210 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;
 
    ---------------------------------
-- 
2.43.2


  parent reply	other threads:[~2024-05-20  7:49 UTC|newest]

Thread overview: 30+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2024-05-20  7:48 [COMMITTED 01/30] ada: Rework and augment documentation on strict aliasing Marc Poulhiès
2024-05-20  7:48 ` [COMMITTED 02/30] ada: Small cleanup in System.Finalization_Primitives unit Marc Poulhiès
2024-05-20  7:48 ` Marc Poulhiès [this message]
2024-05-20  7:48 ` [COMMITTED 04/30] ada: Detect only conflict with synomyms of max queue length Marc Poulhiès
2024-05-20  7:48 ` [COMMITTED 05/30] ada: One more adjustment coming from aliasing considerations Marc Poulhiès
2024-05-20  7:48 ` [COMMITTED 06/30] ada: Reject too-strict alignment specifications Marc Poulhiès
2024-05-20  7:48 ` [COMMITTED 07/30] ada: Use System.Address for address computation in System.Pool_Global Marc Poulhiès
2024-05-20  7:48 ` [COMMITTED 08/30] ada: Fix for attribute Width on enumeration types with Discard_Name Marc Poulhiès
2024-05-20  7:48 ` [COMMITTED 09/30] ada: Fix static 'Img for enumeration type with Discard_Names Marc Poulhiès
2024-05-20  7:48 ` [COMMITTED 10/30] ada: Another small cleanup about allocators and aggregates Marc Poulhiès
2024-05-20  7:48 ` [COMMITTED 11/30] ada: Fix incorrect free with Task_Info pragma Marc Poulhiès
2024-05-20  7:48 ` [COMMITTED 12/30] ada: Resolve ACATS compilation and execution issues with container aggregates Marc Poulhiès
2024-05-20  7:48 ` [COMMITTED 13/30] ada: Extend expansion delaying mechanism to conditional expressions Marc Poulhiès
2024-05-20  7:48 ` [COMMITTED 14/30] ada: Tweak handling of thread ID on POSIX Marc Poulhiès
2024-05-20  7:48 ` [COMMITTED 15/30] ada: Fix style in list of implementation-defined attributes Marc Poulhiès
2024-05-20  7:48 ` [COMMITTED 16/30] ada: Use discrete choice list in declaration of universal type attributes Marc Poulhiès
2024-05-20  7:48 ` [COMMITTED 17/30] ada: Remove repeated condition in check for implementation attributes Marc Poulhiès
2024-05-20  7:48 ` [COMMITTED 18/30] ada: Apply restriction No_Implementation_Attributes to source nodes only Marc Poulhiès
2024-05-20  7:48 ` [COMMITTED 19/30] ada: Fix list of attributes defined by Ada 2012 Marc Poulhiès
2024-05-20  7:48 ` [COMMITTED 20/30] ada: Fix list of implementation-defined attributes Marc Poulhiès
2024-05-20  7:48 ` [COMMITTED 21/30] ada: Further refine 'Super attribute Marc Poulhiès
2024-05-20  7:48 ` [COMMITTED 22/30] ada: Handle accessibility calculations for 'First and 'Last Marc Poulhiès
2024-05-20  7:48 ` [COMMITTED 23/30] ada: Error on instantiation of generic containing legal container aggregate Marc Poulhiès
2024-05-20  7:48 ` [COMMITTED 24/30] " Marc Poulhiès
2024-05-20  7:48 ` [COMMITTED 25/30] ada: Add Is_Base_Type predicate to C interface Marc Poulhiès
2024-05-20  7:48 ` [COMMITTED 26/30] ada: Formal package comment corrections in sinfo.ads Marc Poulhiès
2024-05-20  7:48 ` [COMMITTED 27/30] ada: Get rid of secondary stack for indefinite record types with size clause Marc Poulhiès
2024-05-20  7:48 ` [COMMITTED 28/30] ada: Fix internal error on nested aggregate in conditional expression Marc Poulhiès
2024-05-20  7:48 ` [COMMITTED 29/30] ada: Add direct workaround for limitations of RTSfind mechanism Marc Poulhiès
2024-05-20  7:48 ` [COMMITTED 30/30] ada: Allow 'others' in formal packages with overloaded formals Marc Poulhiès

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=20240520074858.222435-3-poulhies@adacore.com \
    --to=poulhies@adacore.com \
    --cc=gcc-patches@gcc.gnu.org \
    --cc=ruiz@adacore.com \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).