[Ada] Implement pragma Max_Entry_Queue_Length

Programming / Compilers / GCC - pmderodat [138bc75d-0d04-0410-961f-82ee72b054a4] - 13 August 2019 08:07 EDT

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

2019-08-13 Justin Squirek

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.

da558db074a [Ada] Implement pragma Max_Entry_Queue_Length
gcc/ada/ChangeLog | 14 ++++++++++++++
gcc/ada/aspects.adb | 1 +
gcc/ada/aspects.ads | 7 ++++++-
gcc/ada/par-prag.adb | 1 +
gcc/ada/sem_ch13.adb | 14 ++++++++++++++
gcc/ada/sem_prag.adb | 19 ++++++++++++-------
gcc/ada/sem_prag.ads | 1 +
gcc/ada/snames.ads-tmpl | 5 +++--
8 files changed, 52 insertions(+), 10 deletions(-)

Upstream: gcc.gnu.org


  • Share