diff options
author | Eric Botcazou <ebotcazou@adacore.com> | 2022-06-28 18:51:30 +0200 |
---|---|---|
committer | Pierre-Marie de Rodat <derodat@adacore.com> | 2022-07-12 12:24:14 +0000 |
commit | 433cefcd0252ad8aae2aa8a69fbd9900809063b7 (patch) | |
tree | 09d1652cfa70a2ac0f2263509b89871328232eda /gcc/ada/restrict.adb | |
parent | 0ff936fe86ddff4d4a95a4ca9eda85ad0287ffa5 (diff) | |
download | gcc-433cefcd0252ad8aae2aa8a69fbd9900809063b7.zip gcc-433cefcd0252ad8aae2aa8a69fbd9900809063b7.tar.gz gcc-433cefcd0252ad8aae2aa8a69fbd9900809063b7.tar.bz2 |
[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.
Diffstat (limited to 'gcc/ada/restrict.adb')
-rw-r--r-- | gcc/ada/restrict.adb | 91 |
1 files changed, 70 insertions, 21 deletions
diff --git a/gcc/ada/restrict.adb b/gcc/ada/restrict.adb index d62572e..cf43ca9 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 -- --------------------- |