This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Ada] Implement pragma Max_Entry_Queue_Length
- From: Pierre-Marie de Rodat <derodat at adacore dot com>
- To: gcc-patches at gcc dot gnu dot org
- Cc: Justin Squirek <squirek at adacore dot com>
- Date: Tue, 13 Aug 2019 04:31:57 -0400
- Subject: [Ada] Implement pragma Max_Entry_Queue_Length
This patch implements AI12-0164-1 for the aspect/pragma
Max_Entry_Queue_Length. Previously, the GNAT specific pragma
Max_Queue_Length fulfilled this role, but was not named to match the
standard and thus was insufficent.
------------
-- Source --
------------
-- pass.ads
with System;
package Pass is
SOMETHING : constant Integer := 5;
Variable : Boolean := False;
protected type Protected_Example is
entry A (Item : Integer)
with Max_Entry_Queue_Length => 2; -- OK
entry B (Item : Integer);
pragma Max_Entry_Queue_Length (SOMETHING); -- OK
entry C (Item : Integer); -- OK
entry D (Item : Integer)
with Max_Entry_Queue_Length => 4; -- OK
entry D (Item : Integer; Item_B : Integer)
with Max_Entry_Queue_Length => Float'Digits; -- OK
entry E (Item : Integer);
pragma Max_Entry_Queue_Length (SOMETHING * 2); -- OK
entry E (Item : Integer; Item_B : Integer);
pragma Max_Entry_Queue_Length (11); -- OK
entry F (Item : Integer; Item_B : Integer);
pragma Pre (Variable = True);
pragma Max_Entry_Queue_Length (11); -- OK
entry G (Item : Integer; Item_B : Integer)
with Pre => (Variable = True),
Max_Entry_Queue_Length => 11; -- OK
private
Data : Boolean := True;
end Protected_Example;
Prot_Ex : Protected_Example;
end Pass;
-- fail.ads
package Fail is
-- Not near entry
pragma Max_Entry_Queue_Length (40); -- ERROR
-- Task type
task type Task_Example is
entry Insert (Item : in Integer)
with Max_Entry_Queue_Length => 10; -- ERROR
-- Entry family in task type
entry A (Positive) (Item : in Integer)
with Max_Entry_Queue_Length => 10; -- ERROR
end Task_Example;
Task_Ex : Task_Example;
-- Aspect applied to protected type
protected type Protected_Failure_0
with Max_Entry_Queue_Length => 50 is -- ERROR
entry A (Item : Integer);
private
Data : Integer := 0;
end Protected_Failure_0;
Protected_Failure_0_Ex : Protected_Failure_0;
protected type Protected_Failure is
pragma Max_Entry_Queue_Length (10); -- ERROR
-- Duplicates
entry A (Item : Integer)
with Max_Entry_Queue_Length => 10; -- OK
pragma Max_Entry_Queue_Length (4); -- ERROR
entry B (Item : Integer);
pragma Max_Entry_Queue_Length (40); -- OK
pragma Max_Entry_Queue_Length (4); -- ERROR
entry C (Item : Integer)
with Max_Entry_Queue_Length => 10, -- OK
Max_Entry_Queue_Length => 40; -- ERROR
-- Duplicates with the same value
entry AA (Item : Integer)
with Max_Entry_Queue_Length => 10; -- OK
pragma Max_Entry_Queue_Length (10); -- ERROR
entry BB (Item : Integer);
pragma Max_Entry_Queue_Length (40); -- OK
pragma Max_Entry_Queue_Length (40); -- ERROR
entry CC (Item : Integer)
with Max_Entry_Queue_Length => 10, -- OK
Max_Entry_Queue_Length => 10; -- ERROR
-- On subprogram
procedure D (Item : Integer)
with Max_Entry_Queue_Length => 10; -- ERROR
procedure E (Item : Integer);
pragma Max_Entry_Queue_Length (4); -- ERROR
function F (Item : Integer) return Integer
with Max_Entry_Queue_Length => 10; -- ERROR
function G (Item : Integer) return Integer;
pragma Max_Entry_Queue_Length (4); -- ERROR
-- Bad parameters
entry H (Item : Integer)
with Max_Entry_Queue_Length => 0; -- ERROR
entry I (Item : Integer)
with Max_Entry_Queue_Length => -1; -- ERROR
entry J (Item : Integer)
with Max_Entry_Queue_Length => 16#FFFF_FFFF_FFFF_FFFF_FFFF#; -- ERROR
entry K (Item : Integer)
with Max_Entry_Queue_Length => False; -- ERROR
entry L (Item : Integer)
with Max_Entry_Queue_Length => "JUNK"; -- ERROR
entry M (Item : Integer)
with Max_Entry_Queue_Length => 1.0; -- ERROR
entry N (Item : Integer)
with Max_Entry_Queue_Length => Long_Integer'(3); -- ERROR
-- Entry family
entry O (Boolean) (Item : Integer)
with Max_Entry_Queue_Length => 5; -- ERROR
private
Data : Integer := 0;
end Protected_Failure;
I : Positive := 1;
Protected_Failure_Ex : Protected_Failure;
end Fail;
-- dtest.adb
with Ada.Text_IO; use Ada.Text_IO;
procedure Dtest is
protected Prot is
entry Wait;
pragma Max_Entry_Queue_Length (2);
procedure Wakeup;
private
Barrier : Boolean := False;
end Prot;
protected body Prot is
entry Wait when Barrier is
begin
null;
end Wait;
procedure Wakeup is
begin
Barrier := True;
end Wakeup;
end Prot;
task type T;
task body T is
begin
Put_Line ("Waiting...");
Prot.Wait;
exception
when others =>
Put_Line ("Got exception");
end T;
T1, T2 : T;
begin
delay 0.1;
Prot.Wait;
Put_Line ("Done");
exception
when others =>
Put_Line ("Main got exception");
Prot.Wakeup;
end Dtest;
----------------------------
-- Compilation and output --
----------------------------
& gcc -c -g -gnatDG pass.ads
& gcc -c -g fail.ads
& grep -c "(2, 5, 0, 4, 6, 10, 11, 11, 11)" pass.ads.dg
& gnatmake -g -q dtest
fail.ads:5:04: pragma "Max_Entry_Queue_Length" must apply to a protected entry
fail.ads:12:15: aspect "Max_Entry_Queue_Length" cannot apply to task entries
fail.ads:17:15: aspect "Max_Entry_Queue_Length" cannot apply to task entries
fail.ads:26:12: aspect "Max_Entry_Queue_Length" must apply to a protected entry
fail.ads:36:07: pragma "Max_Entry_Queue_Length" must apply to a protected entry
fail.ads:42:07: pragma "Max_Entry_Queue_Length" duplicates aspect declared at
line 41
fail.ads:46:07: pragma "Max_Entry_Queue_Length" duplicates pragma declared at
line 45
fail.ads:50:15: aspect "Max_Entry_Queue_Length" for "C" previously given at
line 49
fail.ads:56:07: pragma "Max_Entry_Queue_Length" duplicates aspect declared at
line 55
fail.ads:60:07: pragma "Max_Entry_Queue_Length" duplicates pragma declared at
line 59
fail.ads:64:15: aspect "Max_Entry_Queue_Length" for "CC" previously given at
line 63
fail.ads:69:15: aspect "Max_Entry_Queue_Length" must apply to a protected entry
fail.ads:72:07: pragma "Max_Entry_Queue_Length" must apply to a protected entry
fail.ads:75:15: aspect "Max_Entry_Queue_Length" must apply to a protected entry
fail.ads:78:07: pragma "Max_Entry_Queue_Length" must apply to a protected entry
fail.ads:83:35: entity for aspect "Max_Entry_Queue_Length" must be positive
fail.ads:86:35: entity for aspect "Max_Entry_Queue_Length" must be positive
fail.ads:89:35: entity for aspect "Max_Entry_Queue_Length" out of range of
Integer
fail.ads:92:35: expected an integer type
fail.ads:92:35: found type "Standard.Boolean"
fail.ads:95:35: expected an integer type
fail.ads:95:35: found a string type
fail.ads:98:35: expected an integer type
fail.ads:98:35: found type universal real
Tested on x86_64-pc-linux-gnu, committed on trunk
2019-08-13 Justin Squirek <squirek@adacore.com>
gcc/ada/
* aspects.adb, aspects.ads: Register new aspect.
* par-prag.adb (Prag): Register new pragma
* sem_ch13.adb (Analyze_Aspect_Specifications): Add processing
for new aspect similar to Aspect_Max_Entry_Queue_Length.
* sem_prag.adb, sem_prag.ads (Analyze_Pragma): Register new
pragma and set it to use the same processing as
Pragma_Max_Queue_Length.
* snames.ads-tmpl: Move definition of
Name_Max_Entry_Queue_Length so that it can be processed as a
pragma in addition to a restriction and add an entry for the
pragma itself.--- gcc/ada/aspects.adb
+++ gcc/ada/aspects.adb
@@ -572,6 +572,7 @@ package body Aspects is
Aspect_Lock_Free => Aspect_Lock_Free,
Aspect_Machine_Radix => Aspect_Machine_Radix,
Aspect_Max_Entry_Queue_Depth => Aspect_Max_Entry_Queue_Depth,
+ Aspect_Max_Entry_Queue_Length => Aspect_Max_Entry_Queue_Length,
Aspect_Max_Queue_Length => Aspect_Max_Queue_Length,
Aspect_No_Caching => Aspect_No_Caching,
Aspect_No_Elaboration_Code_All => Aspect_No_Elaboration_Code_All,
--- gcc/ada/aspects.ads
+++ gcc/ada/aspects.ads
@@ -116,7 +116,8 @@ package Aspects is
Aspect_Link_Name,
Aspect_Linker_Section, -- GNAT
Aspect_Machine_Radix,
- Aspect_Max_Entry_Queue_Depth,
+ Aspect_Max_Entry_Queue_Depth, -- GNAT
+ Aspect_Max_Entry_Queue_Length,
Aspect_Max_Queue_Length, -- GNAT
Aspect_No_Caching, -- GNAT
Aspect_Object_Size, -- GNAT
@@ -253,6 +254,7 @@ package Aspects is
Aspect_Invariant => True,
Aspect_Lock_Free => True,
Aspect_Max_Entry_Queue_Depth => True,
+ Aspect_Max_Entry_Queue_Length => True,
Aspect_Max_Queue_Length => True,
Aspect_Object_Size => True,
Aspect_Persistent_BSS => True,
@@ -376,6 +378,7 @@ package Aspects is
Aspect_Linker_Section => Expression,
Aspect_Machine_Radix => Expression,
Aspect_Max_Entry_Queue_Depth => Expression,
+ Aspect_Max_Entry_Queue_Length => Expression,
Aspect_Max_Queue_Length => Expression,
Aspect_No_Caching => Optional_Expression,
Aspect_Object_Size => Expression,
@@ -487,6 +490,7 @@ package Aspects is
Aspect_Lock_Free => Name_Lock_Free,
Aspect_Machine_Radix => Name_Machine_Radix,
Aspect_Max_Entry_Queue_Depth => Name_Max_Entry_Queue_Depth,
+ Aspect_Max_Entry_Queue_Length => Name_Max_Entry_Queue_Length,
Aspect_Max_Queue_Length => Name_Max_Queue_Length,
Aspect_No_Caching => Name_No_Caching,
Aspect_No_Elaboration_Code_All => Name_No_Elaboration_Code_All,
@@ -765,6 +769,7 @@ package Aspects is
Aspect_Initial_Condition => Never_Delay,
Aspect_Initializes => Never_Delay,
Aspect_Max_Entry_Queue_Depth => Never_Delay,
+ Aspect_Max_Entry_Queue_Length => Never_Delay,
Aspect_Max_Queue_Length => Never_Delay,
Aspect_No_Caching => Never_Delay,
Aspect_No_Elaboration_Code_All => Never_Delay,
--- gcc/ada/par-prag.adb
+++ gcc/ada/par-prag.adb
@@ -1415,6 +1415,7 @@ begin
| Pragma_Main
| Pragma_Main_Storage
| Pragma_Max_Entry_Queue_Depth
+ | Pragma_Max_Entry_Queue_Length
| Pragma_Max_Queue_Length
| Pragma_Memory_Size
| Pragma_No_Body
--- gcc/ada/sem_ch13.adb
+++ gcc/ada/sem_ch13.adb
@@ -3014,6 +3014,19 @@ package body Sem_Ch13 is
Insert_Pragma (Aitem);
goto Continue;
+ -- Max_Entry_Queue_Length
+
+ when Aspect_Max_Entry_Queue_Length =>
+ Make_Aitem_Pragma
+ (Pragma_Argument_Associations => New_List (
+ Make_Pragma_Argument_Association (Loc,
+ Expression => Relocate_Node (Expr))),
+ Pragma_Name => Name_Max_Entry_Queue_Length);
+
+ Decorate (Aspect, Aitem);
+ Insert_Pragma (Aitem);
+ goto Continue;
+
-- Max_Queue_Length
when Aspect_Max_Queue_Length =>
@@ -9651,6 +9664,7 @@ package body Sem_Ch13 is
| Aspect_Initial_Condition
| Aspect_Initializes
| Aspect_Max_Entry_Queue_Depth
+ | Aspect_Max_Entry_Queue_Length
| Aspect_Max_Queue_Length
| Aspect_No_Caching
| Aspect_Obsolescent
--- gcc/ada/sem_prag.adb
+++ gcc/ada/sem_prag.adb
@@ -19572,16 +19572,18 @@ package body Sem_Prag is
end loop;
end Main_Storage;
- ----------------------
- -- Max_Queue_Length --
- ----------------------
+ ----------------------------
+ -- Max_Entry_Queue_Length --
+ ----------------------------
- -- pragma Max_Queue_Length (static_integer_EXPRESSION);
+ -- pragma Max_Entry_Queue_Length (static_integer_EXPRESSION);
- -- This processing is shared by Pragma_Max_Entry_Queue_Depth
+ -- This processing is shared by Pragma_Max_Entry_Queue_Depth and
+ -- Pragma_Max_Queue_Length.
- when Pragma_Max_Queue_Length
+ when Pragma_Max_Entry_Queue_Length
| Pragma_Max_Entry_Queue_Depth
+ | Pragma_Max_Queue_Length
=>
Max_Queue_Length : declare
Arg : Node_Id;
@@ -19590,7 +19592,9 @@ package body Sem_Prag is
Val : Uint;
begin
- if Prag_Id = Pragma_Max_Queue_Length then
+ if Prag_Id = Pragma_Max_Entry_Queue_Depth
+ or else Prag_Id = Pragma_Max_Queue_Length
+ then
GNAT_Pragma;
end if;
@@ -31059,6 +31063,7 @@ package body Sem_Prag is
Pragma_Main => -1,
Pragma_Main_Storage => -1,
Pragma_Max_Entry_Queue_Depth => 0,
+ Pragma_Max_Entry_Queue_Length => 0,
Pragma_Max_Queue_Length => 0,
Pragma_Memory_Size => 0,
Pragma_No_Body => 0,
--- gcc/ada/sem_prag.ads
+++ gcc/ada/sem_prag.ads
@@ -399,6 +399,7 @@ package Sem_Prag is
-- Global
-- Initializes
-- Max_Entry_Queue_Depth
+ -- Max_Entry_Queue_Length
-- Max_Queue_Length
-- Post
-- Post_Class
--- gcc/ada/snames.ads-tmpl
+++ gcc/ada/snames.ads-tmpl
@@ -592,7 +592,8 @@ package Snames is
Name_Machine_Attribute : constant Name_Id := N + $; -- GNAT
Name_Main : constant Name_Id := N + $; -- GNAT
Name_Main_Storage : constant Name_Id := N + $; -- GNAT
- Name_Max_Entry_Queue_Depth : constant Name_Id := N + $; -- Ada 12
+ Name_Max_Entry_Queue_Depth : constant Name_Id := N + $; -- GNAT
+ Name_Max_Entry_Queue_Length : constant Name_Id := N + $; -- Ada 12
Name_Max_Queue_Length : constant Name_Id := N + $; -- GNAT
Name_Memory_Size : constant Name_Id := N + $; -- Ada 83
Name_No_Body : constant Name_Id := N + $; -- GNAT
@@ -782,7 +783,6 @@ package Snames is
Name_Link_Name : constant Name_Id := N + $;
Name_Low_Order_First : constant Name_Id := N + $;
Name_Lowercase : constant Name_Id := N + $;
- Name_Max_Entry_Queue_Length : constant Name_Id := N + $;
Name_Max_Size : constant Name_Id := N + $;
Name_Mechanism : constant Name_Id := N + $;
Name_Message : constant Name_Id := N + $;
@@ -2007,6 +2007,7 @@ package Snames is
Pragma_Main,
Pragma_Main_Storage,
Pragma_Max_Entry_Queue_Depth,
+ Pragma_Max_Entry_Queue_Length,
Pragma_Max_Queue_Length,
Pragma_Memory_Size,
Pragma_No_Body,