[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

1 files changed, 5 insertions, 0 deletions

diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads
index 16dcab8..3038020 100644
--- a/gcc/ada/aspects.ads
+++ b/gcc/ada/aspects.ads
@@ -116,6 +116,7 @@ package Aspects is
       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
@@ -250,6 +251,7 @@ package Aspects is
       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,
@@ -358,6 +360,7 @@ package Aspects is
       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,
@@ -467,6 +470,7 @@ package Aspects is
       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,
@@ -743,6 +747,7 @@ package Aspects is
       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,