From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 1914) id 6BFB9389118A; Tue, 12 Jul 2022 12:26:58 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 6BFB9389118A MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Type: text/plain; charset="utf-8" From: Pierre-Marie de Rodat To: gcc-cvs@gcc.gnu.org Subject: [gcc r13-1641] [Ada] Extend No_Dependence restriction to code generation X-Act-Checkin: gcc X-Git-Author: Eric Botcazou X-Git-Refname: refs/heads/master X-Git-Oldrev: 0ff936fe86ddff4d4a95a4ca9eda85ad0287ffa5 X-Git-Newrev: 433cefcd0252ad8aae2aa8a69fbd9900809063b7 Message-Id: <20220712122658.6BFB9389118A@sourceware.org> Date: Tue, 12 Jul 2022 12:26:58 +0000 (GMT) X-BeenThere: gcc-cvs@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-cvs mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Tue, 12 Jul 2022 12:26:58 -0000 https://gcc.gnu.org/g:433cefcd0252ad8aae2aa8a69fbd9900809063b7 commit r13-1641-g433cefcd0252ad8aae2aa8a69fbd9900809063b7 Author: Eric Botcazou Date: Tue Jun 28 18:51:30 2022 +0200 [Ada] Extend No_Dependence restriction to code generation This makes it possible to report violations of the No_Dependence restriction during code generation, in other words outside of the Ada front-end proper. These violations are supposed to be only for child units of System, so the implementation is restricted to these cases. gcc/ada/ * restrict.ads (type ND_Entry): Add System_Child component. (Check_Restriction_No_Dependence_On_System): Declare. * restrict.adb (Global_Restriction_No_Tasking): Move around. (Violation_Of_No_Dependence): New procedure. (Check_Restriction_No_Dependence): Call Violation_Of_No_Dependence to report a violation. (Check_Restriction_No_Dependence_On_System): New procedure. (Set_Restriction_No_Dependenc): Set System_Child component if the unit is a child of System. * snames.ads-tmpl (Name_Arith_64): New package name. (Name_Arith_128): Likewise. (Name_Memory): Likewise. (Name_Stack_Checking): Likewise. * fe.h (Check_Restriction_No_Dependence_On_System): Declare. Diff: --- gcc/ada/fe.h | 3 ++ gcc/ada/restrict.adb | 91 +++++++++++++++++++++++++++++++++++++------------ gcc/ada/restrict.ads | 10 ++++++ gcc/ada/snames.ads-tmpl | 4 +++ 4 files changed, 87 insertions(+), 21 deletions(-) diff --git a/gcc/ada/fe.h b/gcc/ada/fe.h index 983f6c3a441..b002bdc0056 100644 --- a/gcc/ada/fe.h +++ b/gcc/ada/fe.h @@ -252,6 +252,8 @@ extern Boolean SJLJ_Exceptions (void); restrict__check_no_implicit_protected_alloc #define Check_No_Implicit_Task_Alloc \ restrict__check_no_implicit_task_alloc +#define Check_Restriction_No_Dependence_On_System \ + restrict__check_restriction_no_dependence_on_system #define No_Exception_Handlers_Set \ restrict__no_exception_handlers_set #define No_Exception_Propagation_Active \ @@ -262,6 +264,7 @@ extern void Check_Implicit_Dynamic_Code_Allowed (Node_Id); extern void Check_No_Implicit_Heap_Alloc (Node_Id); extern void Check_No_Implicit_Protected_Alloc (Node_Id); extern void Check_No_Implicit_Task_Alloc (Node_Id); +extern void Check_Restriction_No_Dependence_On_System (Name_Id, Node_Id); extern Boolean No_Exception_Handlers_Set (void); extern Boolean No_Exception_Propagation_Active (void); diff --git a/gcc/ada/restrict.adb b/gcc/ada/restrict.adb index d62572ef54b..cf43ca91e7d 100644 --- a/gcc/ada/restrict.adb +++ b/gcc/ada/restrict.adb @@ -44,10 +44,6 @@ with Uname; use Uname; package body Restrict is - Global_Restriction_No_Tasking : Boolean := False; - -- Set to True when No_Tasking is set in the run-time package System - -- or in a configuration pragmas file (for example, gnat.adc). - -------------------------------- -- Package Local Declarations -- -------------------------------- @@ -55,6 +51,10 @@ package body Restrict is Config_Cunit_Boolean_Restrictions : Save_Cunit_Boolean_Restrictions; -- Save compilation unit restrictions set by config pragma files + Global_Restriction_No_Tasking : Boolean := False; + -- Set to True when No_Tasking is set in the run-time package System + -- or in a configuration pragmas file (for example, gnat.adc). + Restricted_Profile_Result : Boolean := False; -- This switch memoizes the result of Restricted_Profile function calls for -- improved efficiency. Valid only if Restricted_Profile_Cached is True. @@ -122,6 +122,11 @@ package body Restrict is -- message is to be suppressed if this is an internal file and this file is -- not the main unit. Returns True if message is to be suppressed. + procedure Violation_Of_No_Dependence (Unit : Int; N : Node_Id); + -- Called if a violation of restriction No_Dependence for Unit at node N + -- is found. This routine outputs the appropriate message, taking care of + -- warning vs real violation. + ------------------- -- Abort_Allowed -- ------------------- @@ -550,8 +555,6 @@ package body Restrict is ------------------------------------- procedure Check_Restriction_No_Dependence (U : Node_Id; Err : Node_Id) is - DU : Node_Id; - begin -- Ignore call if node U is not in the main source unit. This avoids -- cascaded errors, e.g. when Ada.Containers units with other units. @@ -567,26 +570,33 @@ package body Restrict is -- Loop through entries in No_Dependence table to check each one in turn for J in No_Dependences.First .. No_Dependences.Last loop - DU := No_Dependences.Table (J).Unit; + if Same_Unit (No_Dependences.Table (J).Unit, U) then + Violation_Of_No_Dependence (J, Err); + return; + end if; + end loop; + end Check_Restriction_No_Dependence; - if Same_Unit (U, DU) then - Error_Msg_Sloc := Sloc (DU); - Error_Msg_Node_1 := DU; + ----------------------------------------------- + -- Check_Restriction_No_Dependence_On_System -- + ----------------------------------------------- - if No_Dependences.Table (J).Warn then - Error_Msg - ("?*?violation of restriction `No_Dependence '='> &`#", - Sloc (Err)); - else - Error_Msg - ("|violation of restriction `No_Dependence '='> &`#", - Sloc (Err)); - end if; + procedure Check_Restriction_No_Dependence_On_System + (U : Name_Id; + Err : Node_Id) + is + pragma Assert (U /= No_Name); + + begin + -- Loop through entries in No_Dependence table to check each one in turn + for J in No_Dependences.First .. No_Dependences.Last loop + if No_Dependences.Table (J).System_Child = U then + Violation_Of_No_Dependence (J, Err); return; end if; end loop; - end Check_Restriction_No_Dependence; + end Check_Restriction_No_Dependence_On_System; -------------------------------------------------- -- Check_Restriction_No_Specification_Of_Aspect -- @@ -1474,6 +1484,8 @@ package body Restrict is Warn : Boolean; Profile : Profile_Name := No_Profile) is + ND : ND_Entry; + begin -- Loop to check for duplicate entry @@ -1495,7 +1507,26 @@ package body Restrict is -- Entry is not currently in table - No_Dependences.Append ((Unit, Warn, Profile)); + ND := (Unit, No_Name, Warn, Profile); + + -- Check whether this is a child unit of System + + if Nkind (Unit) = N_Selected_Component then + declare + Root : Node_Id := Unit; + + begin + while Nkind (Prefix (Root)) = N_Selected_Component loop + Root := Prefix (Root); + end loop; + + if Chars (Prefix (Root)) = Name_System then + ND.System_Child := Chars (Selector_Name (Root)); + end if; + end; + end if; + + No_Dependences.Append (ND); end Set_Restriction_No_Dependence; -------------------------------------- @@ -1647,6 +1678,24 @@ package body Restrict is end if; end Suppress_Restriction_Message; + -------------------------------- + -- Violation_Of_No_Dependence -- + -------------------------------- + + procedure Violation_Of_No_Dependence (Unit : Int; N : Node_Id) is + begin + Error_Msg_Node_1 := No_Dependences.Table (Unit).Unit; + Error_Msg_Sloc := Sloc (Error_Msg_Node_1); + + if No_Dependences.Table (Unit).Warn then + Error_Msg + ("?*?violation of restriction `No_Dependence '='> &`#", Sloc (N)); + else + Error_Msg + ("|violation of restriction `No_Dependence '='> &`#", Sloc (N)); + end if; + end Violation_Of_No_Dependence; + --------------------- -- Tasking_Allowed -- --------------------- diff --git a/gcc/ada/restrict.ads b/gcc/ada/restrict.ads index 040e83c776c..7a5c0ff3622 100644 --- a/gcc/ada/restrict.ads +++ b/gcc/ada/restrict.ads @@ -168,6 +168,9 @@ package Restrict is Unit : Node_Id; -- The unit parameter from the No_Dependence pragma + System_Child : Name_Id; + -- The name if the unit is a child of System, or else No_Name + Warn : Boolean; -- True if from Restriction_Warnings, False if from Restrictions @@ -269,6 +272,13 @@ package Restrict is -- an explicit WITH clause). U is a node for the unit involved, and Err is -- the node to which an error will be attached if necessary. + procedure Check_Restriction_No_Dependence_On_System + (U : Name_Id; + Err : Node_Id); + -- Likewise, but for the child units of System referenced by their name + + -- WARNING: There is a matching C declaration of this subprogram in fe.h + procedure Check_Restriction_No_Specification_Of_Aspect (N : Node_Id); -- N is the node id for an N_Aspect_Specification, an N_Pragma, or an -- N_Attribute_Definition_Clause. An error message (warning) will be issued diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index 0a1ff80dbd2..44465e75707 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -274,10 +274,14 @@ package Snames is -- Names for packages that are treated specially by the compiler + Name_Arith_64 : constant Name_Id := N + $; + Name_Arith_128 : constant Name_Id := N + $; Name_Exception_Traces : constant Name_Id := N + $; Name_Finalization : constant Name_Id := N + $; Name_Interfaces : constant Name_Id := N + $; + Name_Memory : constant Name_Id := N + $; Name_Most_Recent_Exception : constant Name_Id := N + $; + Name_Stack_Checking : constant Name_Id := N + $; Name_Standard : constant Name_Id := N + $; Name_System : constant Name_Id := N + $; Name_Text_IO : constant Name_Id := N + $;