[Ada] Implement pragma Max_Entry_Queue_Depth
authorJustin Squirek <squirek@adacore.com>
Wed, 30 May 2018 08:58:33 +0000 (08:58 +0000)
committerPierre-Marie de Rodat <pmderodat@gcc.gnu.org>
Wed, 30 May 2018 08:58:33 +0000 (08:58 +0000)
commit656d1fba78c6a743d8d65a1383400a756dfd9222
tree3d1863c078175c1f4666caabf329b4a3576da781
parentd7db3f4f65563632493aa82c1cf12c7ed3f89eff
[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
gcc/ada/ChangeLog
gcc/ada/aspects.adb
gcc/ada/aspects.ads
gcc/ada/par-prag.adb
gcc/ada/sem_ch13.adb
gcc/ada/sem_prag.adb
gcc/ada/sem_prag.ads
gcc/ada/snames.ads-tmpl