This patch implements AI12-0164-1 for the aspect/pragma Max_Entry_Queue_Depth.
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_Depth => 2; -- OK
entry B (Item : Integer);
pragma Max_Entry_Queue_Depth (SOMETHING); -- OK
entry C (Item : Integer); -- OK
entry D (Item : Integer)
with Max_Entry_Queue_Depth => 4; -- OK
entry D (Item : Integer; Item_B : Integer)
with Max_Entry_Queue_Depth => Float'Digits; -- OK
entry E (Item : Integer);
pragma Max_Entry_Queue_Depth (SOMETHING * 2); -- OK
entry E (Item : Integer; Item_B : Integer);
pragma Max_Entry_Queue_Depth (11); -- OK
entry F (Item : Integer; Item_B : Integer);
pragma Pre (Variable = True);
pragma Max_Entry_Queue_Depth (11); -- OK
entry G (Item : Integer; Item_B : Integer)
with Pre => (Variable = True),
Max_Entry_Queue_Depth => 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_Depth (40); -- ERROR
-- Task type
task type Task_Example is
entry Insert (Item : in Integer)
with Max_Entry_Queue_Depth => 10; -- ERROR
-- Entry family in task type
entry A (Positive) (Item : in Integer)
with Max_Entry_Queue_Depth => 10; -- ERROR
end Task_Example;
Task_Ex : Task_Example;
-- Aspect applied to protected type
protected type Protected_Failure_0
with Max_Entry_Queue_Depth => 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_Depth (10); -- ERROR
-- Duplicates
entry A (Item : Integer)
with Max_Entry_Queue_Depth => 10; -- OK
pragma Max_Entry_Queue_Depth (4); -- ERROR
entry B (Item : Integer);
pragma Max_Entry_Queue_Depth (40); -- OK
pragma Max_Entry_Queue_Depth (4); -- ERROR
entry C (Item : Integer)
with Max_Entry_Queue_Depth => 10, -- OK
Max_Entry_Queue_Depth => 40; -- ERROR
-- Duplicates with the same value
entry AA (Item : Integer)
with Max_Entry_Queue_Depth => 10; -- OK
pragma Max_Entry_Queue_Depth (10); -- ERROR
entry BB (Item : Integer);
pragma Max_Entry_Queue_Depth (40); -- OK
pragma Max_Entry_Queue_Depth (40); -- ERROR
entry CC (Item : Integer)
with Max_Entry_Queue_Depth => 10, -- OK
Max_Entry_Queue_Depth => 10; -- ERROR
-- On subprogram
procedure D (Item : Integer)
with Max_Entry_Queue_Depth => 10; -- ERROR
procedure E (Item : Integer);
pragma Max_Entry_Queue_Depth (4); -- ERROR
function F (Item : Integer) return Integer
with Max_Entry_Queue_Depth => 10; -- ERROR
function G (Item : Integer) return Integer;
pragma Max_Entry_Queue_Depth (4); -- ERROR
-- Bad parameters
entry H (Item : Integer)
with Max_Entry_Queue_Depth => 0; -- ERROR
entry I (Item : Integer)
with Max_Entry_Queue_Depth => -1; -- ERROR
entry J (Item : Integer)
with Max_Entry_Queue_Depth => 16#FFFF_FFFF_FFFF_FFFF_FFFF#; -- ERROR
entry K (Item : Integer)
with Max_Entry_Queue_Depth => False; -- ERROR
entry L (Item : Integer)
with Max_Entry_Queue_Depth => "JUNK"; -- ERROR
entry M (Item : Integer)
with Max_Entry_Queue_Depth => 1.0; -- ERROR
entry N (Item : Integer)
with Max_Entry_Queue_Depth => Long_Integer'(3); -- ERROR
-- Entry family
entry O (Boolean) (Item : Integer)
with Max_Entry_Queue_Depth => 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_Depth (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_Queue_Length" must apply to a protected entry
fail.ads:12:15: aspect "Max_Queue_Length" cannot apply to task entries
fail.ads:17:15: aspect "Max_Queue_Length" cannot apply to task entries
fail.ads:26:12: aspect "Max_Queue_Length" must apply to a protected entry
fail.ads:36:07: pragma "Max_Queue_Length" must apply to a protected entry
fail.ads:42:07: pragma "Max_Queue_Length" duplicates aspect declared at line 41
fail.ads:46:07: pragma "Max_Queue_Length" duplicates pragma declared at line 45
fail.ads:50:15: aspect "Max_Queue_Length" for "C" previously given at line 49
fail.ads:56:07: pragma "Max_Queue_Length" duplicates aspect declared at line 55
fail.ads:60:07: pragma "Max_Queue_Length" duplicates pragma declared at line 59
fail.ads:64:15: aspect "Max_Queue_Length" for "CC" previously given at line 63
fail.ads:69:15: aspect "Max_Queue_Length" must apply to a protected entry
fail.ads:72:07: pragma "Max_Queue_Length" must apply to a protected entry
fail.ads:75:15: aspect "Max_Queue_Length" must apply to a protected entry
fail.ads:78:07: pragma "Max_Queue_Length" must apply to a protected entry
fail.ads:83:35: entity for aspect "Max_Queue_Length" must be positive
fail.ads:86:35: entity for aspect "Max_Queue_Length" must be positive
fail.ads:89:35: entity for aspect "Max_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
2018-05-30 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_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_Depth so
that it can be processed as a pragma in addition to a restriction and
add an entry for the pragma itself.
From-SVN: r260945
+2018-05-30 Justin Squirek <squirek@adacore.com>
+
+ * 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_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_Depth so
+ that it can be processed as a pragma in addition to a restriction and
+ add an entry for the pragma itself.
+
2018-05-30 Ed Schonberg <schonberg@adacore.com>
* freeze.adb (Freeze_Object_Declaration): A pragma Thread_Local_Storage
Aspect_Linker_Section => Aspect_Linker_Section,
Aspect_Lock_Free => Aspect_Lock_Free,
Aspect_Machine_Radix => Aspect_Machine_Radix,
+ Aspect_Max_Entry_Queue_Depth => Aspect_Max_Entry_Queue_Depth,
Aspect_Max_Queue_Length => Aspect_Max_Queue_Length,
Aspect_No_Elaboration_Code_All => Aspect_No_Elaboration_Code_All,
Aspect_No_Inline => Aspect_No_Inline,
Aspect_Link_Name,
Aspect_Linker_Section, -- GNAT
Aspect_Machine_Radix,
+ Aspect_Max_Entry_Queue_Depth,
Aspect_Max_Queue_Length, -- GNAT
Aspect_Object_Size, -- GNAT
Aspect_Obsolescent, -- GNAT
Aspect_Inline_Always => True,
Aspect_Invariant => True,
Aspect_Lock_Free => True,
+ Aspect_Max_Entry_Queue_Depth => True,
Aspect_Max_Queue_Length => True,
Aspect_Object_Size => True,
Aspect_Persistent_BSS => True,
Aspect_Link_Name => Expression,
Aspect_Linker_Section => Expression,
Aspect_Machine_Radix => Expression,
+ Aspect_Max_Entry_Queue_Depth => Expression,
Aspect_Max_Queue_Length => Expression,
Aspect_Object_Size => Expression,
Aspect_Obsolescent => Optional_Expression,
Aspect_Linker_Section => Name_Linker_Section,
Aspect_Lock_Free => Name_Lock_Free,
Aspect_Machine_Radix => Name_Machine_Radix,
+ Aspect_Max_Entry_Queue_Depth => Name_Max_Entry_Queue_Depth,
Aspect_Max_Queue_Length => Name_Max_Queue_Length,
Aspect_No_Elaboration_Code_All => Name_No_Elaboration_Code_All,
Aspect_No_Inline => Name_No_Inline,
Aspect_Import => Never_Delay,
Aspect_Initial_Condition => Never_Delay,
Aspect_Initializes => Never_Delay,
+ Aspect_Max_Entry_Queue_Depth => Never_Delay,
Aspect_Max_Queue_Length => Never_Delay,
Aspect_No_Elaboration_Code_All => Never_Delay,
Aspect_No_Tagged_Streams => Never_Delay,
| Pragma_Machine_Attribute
| Pragma_Main
| Pragma_Main_Storage
+ | Pragma_Max_Entry_Queue_Depth
| Pragma_Max_Queue_Length
| Pragma_Memory_Size
| Pragma_No_Body
goto Continue;
end Initializes;
+ -- Max_Entry_Queue_Depth
+
+ when Aspect_Max_Entry_Queue_Depth =>
+ Make_Aitem_Pragma
+ (Pragma_Argument_Associations => New_List (
+ Make_Pragma_Argument_Association (Loc,
+ Expression => Relocate_Node (Expr))),
+ Pragma_Name => Name_Max_Entry_Queue_Depth);
+
+ Decorate (Aspect, Aitem);
+ Insert_Pragma (Aitem);
+ goto Continue;
+
-- Max_Queue_Length
when Aspect_Max_Queue_Length =>
| Aspect_Implicit_Dereference
| Aspect_Initial_Condition
| Aspect_Initializes
+ | Aspect_Max_Entry_Queue_Depth
| Aspect_Max_Queue_Length
| Aspect_Obsolescent
| Aspect_Part_Of
-- pragma Max_Queue_Length (static_integer_EXPRESSION);
- when Pragma_Max_Queue_Length => Max_Queue_Length : declare
+ -- This processing is shared by Pragma_Max_Entry_Queue_Depth
+
+ when Pragma_Max_Queue_Length
+ | Pragma_Max_Entry_Queue_Depth
+ =>
+ Max_Queue_Length : declare
Arg : Node_Id;
Entry_Decl : Node_Id;
Entry_Id : Entity_Id;
Val : Uint;
begin
- GNAT_Pragma;
+ if Prag_Id = Pragma_Max_Queue_Length then
+ GNAT_Pragma;
+ end if;
+
Check_Arg_Count (1);
Entry_Decl :=
Pragma_Machine_Attribute => -1,
Pragma_Main => -1,
Pragma_Main_Storage => -1,
+ Pragma_Max_Entry_Queue_Depth => 0,
Pragma_Max_Queue_Length => 0,
Pragma_Memory_Size => 0,
Pragma_No_Return => 0,
-- Extensions_Visible
-- Global
-- Initializes
+ -- Max_Entry_Queue_Depth
-- Max_Queue_Length
-- Post
-- Post_Class
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_Queue_Length : constant Name_Id := N + $; -- GNAT
Name_Memory_Size : constant Name_Id := N + $; -- Ada 83
Name_No_Body : constant Name_Id := N + $; -- GNAT
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_Depth : 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 + $;
Pragma_Machine_Attribute,
Pragma_Main,
Pragma_Main_Storage,
+ Pragma_Max_Entry_Queue_Depth,
Pragma_Max_Queue_Length,
Pragma_Memory_Size,
Pragma_No_Body,
projects / gcc.git / commitdiff