[Ada] Implement pragma Max_Entry_Queue_Depth
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