[Ada] Extend No_Dependence restriction to code generation

[Pierre-Marie de Rodat <derodat@adacore.com>]

[-- Attachment #1: Type: text/plain, Size: 1011 bytes --]

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.

Tested on x86_64-pc-linux-gnu, committed on trunk

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.

[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 8589 bytes --]

diff --git a/gcc/ada/fe.h b/gcc/ada/fe.h
--- 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
--- 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
--- 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
--- 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 + $;