From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 114801 invoked by alias); 13 Aug 2019 08:32:41 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Received: (qmail 113746 invoked by uid 89); 13 Aug 2019 08:32:32 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-10.3 required=5.0 tests=BAYES_00,GIT_PATCH_2,GIT_PATCH_3,KAM_ASCII_DIVIDERS,SPF_NEUTRAL,T_FILL_THIS_FORM_SHORT autolearn=ham version=3.3.1 spammy= X-HELO: eggs.gnu.org Received: from eggs.gnu.org (HELO eggs.gnu.org) (209.51.188.92) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Tue, 13 Aug 2019 08:32:29 +0000 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1hxSDo-0001de-Ck for gcc-patches@gcc.gnu.org; Tue, 13 Aug 2019 04:32:04 -0400 Received: from rock.gnat.com ([205.232.38.15]:53675) by eggs.gnu.org with esmtps (TLS1.0:DHE_RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1hxSDo-0001cz-2L for gcc-patches@gcc.gnu.org; Tue, 13 Aug 2019 04:32:00 -0400 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 700DA560F1; Tue, 13 Aug 2019 04:31:59 -0400 (EDT) Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id 16fDiOJFA6eB; Tue, 13 Aug 2019 04:31:59 -0400 (EDT) Received: from tron.gnat.com (tron.gnat.com [IPv6:2620:20:4000:0:46a8:42ff:fe0e:e294]) by rock.gnat.com (Postfix) with ESMTP id 9C03C560F7; Tue, 13 Aug 2019 04:31:57 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4862) id 9ADDE6B4; Tue, 13 Aug 2019 04:31:57 -0400 (EDT) Date: Tue, 13 Aug 2019 08:32:00 -0000 From: Pierre-Marie de Rodat To: gcc-patches@gcc.gnu.org Cc: Justin Squirek Subject: [Ada] Implement pragma Max_Entry_Queue_Length Message-ID: <20190813083157.GA38592@adacore.com> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="Kj7319i9nmIyA2yE" Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) X-detected-operating-system: by eggs.gnu.org: GNU/Linux 3.x X-Received-From: 205.232.38.15 X-IsSubscribed: yes X-SW-Source: 2019-08/txt/msg00812.txt.bz2 --Kj7319i9nmIyA2yE Content-Type: text/plain; charset=us-ascii Content-Disposition: inline Content-length: 8599 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 Tested on x86_64-pc-linux-gnu, committed on trunk 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. --Kj7319i9nmIyA2yE Content-Type: text/x-diff; charset=us-ascii Content-Disposition: attachment; filename="patch.diff" Content-length: 7800 --- gcc/ada/aspects.adb +++ gcc/ada/aspects.adb @@ -572,6 +572,7 @@ package body Aspects is Aspect_Lock_Free => Aspect_Lock_Free, Aspect_Machine_Radix => Aspect_Machine_Radix, Aspect_Max_Entry_Queue_Depth => Aspect_Max_Entry_Queue_Depth, + Aspect_Max_Entry_Queue_Length => Aspect_Max_Entry_Queue_Length, Aspect_Max_Queue_Length => Aspect_Max_Queue_Length, Aspect_No_Caching => Aspect_No_Caching, Aspect_No_Elaboration_Code_All => Aspect_No_Elaboration_Code_All, --- gcc/ada/aspects.ads +++ gcc/ada/aspects.ads @@ -116,7 +116,8 @@ package Aspects is Aspect_Link_Name, Aspect_Linker_Section, -- GNAT Aspect_Machine_Radix, - Aspect_Max_Entry_Queue_Depth, + Aspect_Max_Entry_Queue_Depth, -- GNAT + Aspect_Max_Entry_Queue_Length, Aspect_Max_Queue_Length, -- GNAT Aspect_No_Caching, -- GNAT Aspect_Object_Size, -- GNAT @@ -253,6 +254,7 @@ package Aspects is Aspect_Invariant => True, Aspect_Lock_Free => True, Aspect_Max_Entry_Queue_Depth => True, + Aspect_Max_Entry_Queue_Length => True, Aspect_Max_Queue_Length => True, Aspect_Object_Size => True, Aspect_Persistent_BSS => True, @@ -376,6 +378,7 @@ package Aspects is Aspect_Linker_Section => Expression, Aspect_Machine_Radix => Expression, Aspect_Max_Entry_Queue_Depth => Expression, + Aspect_Max_Entry_Queue_Length => Expression, Aspect_Max_Queue_Length => Expression, Aspect_No_Caching => Optional_Expression, Aspect_Object_Size => Expression, @@ -487,6 +490,7 @@ package Aspects is Aspect_Lock_Free => Name_Lock_Free, Aspect_Machine_Radix => Name_Machine_Radix, Aspect_Max_Entry_Queue_Depth => Name_Max_Entry_Queue_Depth, + Aspect_Max_Entry_Queue_Length => Name_Max_Entry_Queue_Length, Aspect_Max_Queue_Length => Name_Max_Queue_Length, Aspect_No_Caching => Name_No_Caching, Aspect_No_Elaboration_Code_All => Name_No_Elaboration_Code_All, @@ -765,6 +769,7 @@ package Aspects is Aspect_Initial_Condition => Never_Delay, Aspect_Initializes => Never_Delay, Aspect_Max_Entry_Queue_Depth => Never_Delay, + Aspect_Max_Entry_Queue_Length => Never_Delay, Aspect_Max_Queue_Length => Never_Delay, Aspect_No_Caching => Never_Delay, Aspect_No_Elaboration_Code_All => Never_Delay, --- gcc/ada/par-prag.adb +++ gcc/ada/par-prag.adb @@ -1415,6 +1415,7 @@ begin | Pragma_Main | Pragma_Main_Storage | Pragma_Max_Entry_Queue_Depth + | Pragma_Max_Entry_Queue_Length | Pragma_Max_Queue_Length | Pragma_Memory_Size | Pragma_No_Body --- gcc/ada/sem_ch13.adb +++ gcc/ada/sem_ch13.adb @@ -3014,6 +3014,19 @@ package body Sem_Ch13 is Insert_Pragma (Aitem); goto Continue; + -- Max_Entry_Queue_Length + + when Aspect_Max_Entry_Queue_Length => + Make_Aitem_Pragma + (Pragma_Argument_Associations => New_List ( + Make_Pragma_Argument_Association (Loc, + Expression => Relocate_Node (Expr))), + Pragma_Name => Name_Max_Entry_Queue_Length); + + Decorate (Aspect, Aitem); + Insert_Pragma (Aitem); + goto Continue; + -- Max_Queue_Length when Aspect_Max_Queue_Length => @@ -9651,6 +9664,7 @@ package body Sem_Ch13 is | Aspect_Initial_Condition | Aspect_Initializes | Aspect_Max_Entry_Queue_Depth + | Aspect_Max_Entry_Queue_Length | Aspect_Max_Queue_Length | Aspect_No_Caching | Aspect_Obsolescent --- gcc/ada/sem_prag.adb +++ gcc/ada/sem_prag.adb @@ -19572,16 +19572,18 @@ package body Sem_Prag is end loop; end Main_Storage; - ---------------------- - -- Max_Queue_Length -- - ---------------------- + ---------------------------- + -- Max_Entry_Queue_Length -- + ---------------------------- - -- pragma Max_Queue_Length (static_integer_EXPRESSION); + -- pragma Max_Entry_Queue_Length (static_integer_EXPRESSION); - -- This processing is shared by Pragma_Max_Entry_Queue_Depth + -- This processing is shared by Pragma_Max_Entry_Queue_Depth and + -- Pragma_Max_Queue_Length. - when Pragma_Max_Queue_Length + when Pragma_Max_Entry_Queue_Length | Pragma_Max_Entry_Queue_Depth + | Pragma_Max_Queue_Length => Max_Queue_Length : declare Arg : Node_Id; @@ -19590,7 +19592,9 @@ package body Sem_Prag is Val : Uint; begin - if Prag_Id = Pragma_Max_Queue_Length then + if Prag_Id = Pragma_Max_Entry_Queue_Depth + or else Prag_Id = Pragma_Max_Queue_Length + then GNAT_Pragma; end if; @@ -31059,6 +31063,7 @@ package body Sem_Prag is Pragma_Main => -1, Pragma_Main_Storage => -1, Pragma_Max_Entry_Queue_Depth => 0, + Pragma_Max_Entry_Queue_Length => 0, Pragma_Max_Queue_Length => 0, Pragma_Memory_Size => 0, Pragma_No_Body => 0, --- gcc/ada/sem_prag.ads +++ gcc/ada/sem_prag.ads @@ -399,6 +399,7 @@ package Sem_Prag is -- Global -- Initializes -- Max_Entry_Queue_Depth + -- Max_Entry_Queue_Length -- Max_Queue_Length -- Post -- Post_Class --- gcc/ada/snames.ads-tmpl +++ gcc/ada/snames.ads-tmpl @@ -592,7 +592,8 @@ package Snames is 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_Entry_Queue_Depth : constant Name_Id := N + $; -- GNAT + Name_Max_Entry_Queue_Length : 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 @@ -782,7 +783,6 @@ package Snames is 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_Length : constant Name_Id := N + $; Name_Max_Size : constant Name_Id := N + $; Name_Mechanism : constant Name_Id := N + $; Name_Message : constant Name_Id := N + $; @@ -2007,6 +2007,7 @@ package Snames is Pragma_Main, Pragma_Main_Storage, Pragma_Max_Entry_Queue_Depth, + Pragma_Max_Entry_Queue_Length, Pragma_Max_Queue_Length, Pragma_Memory_Size, Pragma_No_Body, --Kj7319i9nmIyA2yE--