aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada/restrict.adb
diff options
context:
space:
mode:
authorEric Botcazou <ebotcazou@adacore.com>2022-06-28 18:51:30 +0200
committerPierre-Marie de Rodat <derodat@adacore.com>2022-07-12 12:24:14 +0000
commit433cefcd0252ad8aae2aa8a69fbd9900809063b7 (patch)
tree09d1652cfa70a2ac0f2263509b89871328232eda /gcc/ada/restrict.adb
parent0ff936fe86ddff4d4a95a4ca9eda85ad0287ffa5 (diff)
downloadgcc-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.adb91
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 --
---------------------