Merge branch 'autopar_rebase2' into autopar_develdevel/autopar_devel

Quickly commit changes in the rebase branch.

1 files changed, 79 insertions, 199 deletions

diff --git a/gcc/ada/restrict.adb b/gcc/ada/restrict.adb
index 8a8e2fa..c63c881 100644
--- a/gcc/ada/restrict.adb
+++ b/gcc/ada/restrict.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2019, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2020, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -35,37 +35,14 @@ with Opt;      use Opt;
 with Sinfo;    use Sinfo;
 with Sinput;   use Sinput;
 with Stand;    use Stand;
+with Targparm; use Targparm;
 with Uname;    use Uname;
 
 package body Restrict is
 
-   -------------------------------
-   -- SPARK Restriction Control --
-   -------------------------------
-
-   --  SPARK HIDE directives allow the effect of the SPARK_05 restriction to be
-   --  turned off for a specified region of code, and the following tables are
-   --  the data structures used to keep track of these regions.
-
-   --  The table contains pairs of source locations, the first being the start
-   --  location for hidden region, and the second being the end location.
-
-   --  Note that the start location is included in the hidden region, while
-   --  the end location is excluded from it. (It typically corresponds to the
-   --  next token during scanning.)
-
-   type SPARK_Hide_Entry is record
-      Start : Source_Ptr;
-      Stop  : Source_Ptr;
-   end record;
-
-   package SPARK_Hides is new Table.Table (
-     Table_Component_Type => SPARK_Hide_Entry,
-     Table_Index_Type     => Natural,
-     Table_Low_Bound      => 1,
-     Table_Initial        => 100,
-     Table_Increment      => 200,
-     Table_Name           => "SPARK Hides");
+   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 --
@@ -260,7 +237,7 @@ package body Restrict is
 
       --  For type conversion, check converted expression
 
-      elsif Nkind_In (Obj, N_Unchecked_Type_Conversion, N_Type_Conversion) then
+      elsif Nkind (Obj) in N_Unchecked_Type_Conversion | N_Type_Conversion then
          Check_No_Implicit_Aliasing (Expression (Obj));
          return;
 
@@ -511,13 +488,6 @@ package body Restrict is
          return;
       end if;
 
-      --  In SPARK 05 mode, issue an error for any use of class-wide, even if
-      --  the No_Dispatch restriction is not set.
-
-      if R = No_Dispatch then
-         Check_SPARK_05_Restriction ("class-wide is not allowed", N);
-      end if;
-
       if UI_Is_In_Int_Range (V) then
          VV := Integer (UI_To_Int (V));
       else
@@ -656,7 +626,14 @@ package body Restrict is
          return;
       end if;
 
-      Id := Identifier (N);
+      if Nkind (N) = N_Pragma then
+         Id := Pragma_Identifier (N);
+      elsif Nkind (N) = N_Attribute_Definition_Clause then
+         Id := N;
+      else
+         Id := Identifier (N);
+      end if;
+
       A_Id := Get_Aspect_Id (Chars (Id));
       pragma Assert (A_Id /= No_Aspect);
 
@@ -769,7 +746,7 @@ package body Restrict is
                            and then Chars (Scope (Ent)) = Name_Ada
                            and then Scope (Scope (Ent)) = Standard_Standard)
                then
-                  if Nkind_In (Expr, N_Identifier, N_Operator_Symbol)
+                  if Nkind (Expr) in N_Identifier | N_Operator_Symbol
                     and then Chars (Ent) = Chars (Expr)
                   then
                      Error_Msg_Node_1 := N;
@@ -786,7 +763,7 @@ package body Restrict is
 
                --  Here if at outer level of entity name in table
 
-               elsif Nkind_In (Expr, N_Identifier, N_Operator_Symbol) then
+               elsif Nkind (Expr) in N_Identifier | N_Operator_Symbol then
                   exit;
 
                --  Here if neither at the outer level
@@ -846,94 +823,6 @@ package body Restrict is
       end if;
    end Check_Restriction_No_Use_Of_Pragma;
 
-   --------------------------------
-   -- Check_SPARK_05_Restriction --
-   --------------------------------
-
-   procedure Check_SPARK_05_Restriction
-     (Msg   : String;
-      N     : Node_Id;
-      Force : Boolean := False)
-   is
-      Msg_Issued          : Boolean;
-      Save_Error_Msg_Sloc : Source_Ptr;
-      Onode               : constant Node_Id := Original_Node (N);
-
-   begin
-      --  Output message if Force set
-
-      if Force
-
-        --  Or if this node comes from source
-
-        or else Comes_From_Source (N)
-
-        --  Or if this is a range node which rewrites a range attribute and
-        --  the range attribute comes from source.
-
-        or else (Nkind (N) = N_Range
-                  and then Nkind (Onode) = N_Attribute_Reference
-                  and then Attribute_Name (Onode) = Name_Range
-                  and then Comes_From_Source (Onode))
-
-        --  Or this is an expression that does not come from source, which is
-        --  a rewriting of an expression that does come from source.
-
-        or else (Nkind (N) in N_Subexpr and then Comes_From_Source (Onode))
-      then
-         if Restriction_Check_Required (SPARK_05)
-           and then Is_In_Hidden_Part_In_SPARK (Sloc (N))
-         then
-            return;
-         end if;
-
-         --  Since the call to Restriction_Msg from Check_Restriction may set
-         --  Error_Msg_Sloc to the location of the pragma restriction, save and
-         --  restore the previous value of the global variable around the call.
-
-         Save_Error_Msg_Sloc := Error_Msg_Sloc;
-         Check_Restriction (Msg_Issued, SPARK_05, First_Node (N));
-         Error_Msg_Sloc := Save_Error_Msg_Sloc;
-
-         if Msg_Issued then
-            Error_Msg_F ("\\| " & Msg, N);
-         end if;
-      end if;
-   end Check_SPARK_05_Restriction;
-
-   procedure Check_SPARK_05_Restriction
-     (Msg1 : String;
-      Msg2 : String;
-      N    : Node_Id)
-   is
-      Msg_Issued          : Boolean;
-      Save_Error_Msg_Sloc : Source_Ptr;
-
-   begin
-      pragma Assert (Msg2'Length /= 0 and then Msg2 (Msg2'First) = '\');
-
-      if Comes_From_Source (Original_Node (N)) then
-         if Restriction_Check_Required (SPARK_05)
-           and then Is_In_Hidden_Part_In_SPARK (Sloc (N))
-         then
-            return;
-         end if;
-
-         --  Since the call to Restriction_Msg from Check_Restriction may set
-         --  Error_Msg_Sloc to the location of the pragma restriction, save and
-         --  restore the previous value of the global variable around the call.
-
-         Save_Error_Msg_Sloc := Error_Msg_Sloc;
-         Check_Restriction (Msg_Issued, SPARK_05, First_Node (N));
-         Error_Msg_Sloc := Save_Error_Msg_Sloc;
-
-         if Msg_Issued then
-            Error_Msg_F ("\\| " & Msg1, N);
-            Error_Msg_F (Msg2, N);
-         end if;
-      end if;
-   end Check_SPARK_05_Restriction;
-
    --------------------------------------
    -- Check_Wide_Character_Restriction --
    --------------------------------------
@@ -1021,24 +910,15 @@ package body Restrict is
       return Not_A_Restriction_Id;
    end Get_Restriction_Id;
 
-   --------------------------------
-   -- Is_In_Hidden_Part_In_SPARK --
-   --------------------------------
+   -----------------------
+   -- Global_No_Tasking --
+   -----------------------
 
-   function Is_In_Hidden_Part_In_SPARK (Loc : Source_Ptr) return Boolean is
+   function Global_No_Tasking return Boolean is
    begin
-      --  Loop through table of hidden ranges
-
-      for J in SPARK_Hides.First .. SPARK_Hides.Last loop
-         if SPARK_Hides.Table (J).Start <= Loc
-           and then Loc < SPARK_Hides.Table (J).Stop
-         then
-            return True;
-         end if;
-      end loop;
-
-      return False;
-   end Is_In_Hidden_Part_In_SPARK;
+      return Global_Restriction_No_Tasking
+        or else Targparm.Restrictions_On_Target.Set (No_Tasking);
+   end Global_No_Tasking;
 
    -------------------------------
    -- No_Exception_Handlers_Set --
@@ -1097,7 +977,7 @@ package body Restrict is
              and then
            OK_No_Use_Of_Entity_Name (Selector_Name (N));
 
-      elsif Nkind_In (N, N_Identifier, N_Operator_Symbol) then
+      elsif Nkind (N) in N_Identifier | N_Operator_Symbol then
          return True;
 
       else
@@ -1134,21 +1014,11 @@ package body Restrict is
          when Name_No_Task_Attributes =>
             New_Name := Name_No_Task_Attributes_Package;
 
-         --  SPARK is special in that we unconditionally warn
-
-         when Name_SPARK =>
-            Error_Msg_Name_1 := Name_SPARK;
-            Error_Msg_N ("restriction identifier % is obsolescent??", N);
-            Error_Msg_Name_1 := Name_SPARK_05;
-            Error_Msg_N ("|use restriction identifier % instead??", N);
-            return Name_SPARK_05;
-
          when others =>
             return Old_Name;
       end case;
 
-      --  Output warning if we are warning on obsolescent features for all
-      --  cases other than SPARK.
+      --  Output warning if we are warning on obsolescent features.
 
       if Warn_On_Obsolescent_Feature then
          Error_Msg_Name_1 := Old_Name;
@@ -1250,8 +1120,7 @@ package body Restrict is
       --  Append given string to Msg, bumping Len appropriately
 
       procedure Id_Case (S : String; Quotes : Boolean := True);
-      --  Given a string S, case it according to current identifier casing,
-      --  except for SPARK_05 (an acronym) which is set all upper case, and
+      --  Given a string S, case it according to current identifier casing, and
       --  store in Error_Msg_String. Then append `~` to the message buffer
       --  to output the string unchanged surrounded in quotes. The quotes
       --  are suppressed if Quotes = False.
@@ -1284,13 +1153,7 @@ package body Restrict is
       begin
          Name_Buffer (1 .. S'Last) := S;
          Name_Len := S'Length;
-
-         if R = SPARK_05 then
-            Set_All_Upper_Case;
-         else
-            Set_Casing (Identifier_Casing (Get_Source_File_Index (Sloc (N))));
-         end if;
-
+         Set_Casing (Identifier_Casing (Get_Source_File_Index (Sloc (N))));
          Error_Msg_Strlen := Name_Len;
          Error_Msg_String (1 .. Name_Len) := Name_Buffer (1 .. Name_Len);
 
@@ -1395,15 +1258,15 @@ package body Restrict is
 
    function Same_Entity (E1, E2 : Node_Id) return Boolean is
    begin
-      if Nkind_In (E1, N_Identifier, N_Operator_Symbol)
+      if Nkind (E1) in N_Identifier | N_Operator_Symbol
            and then
-         Nkind_In (E2, N_Identifier, N_Operator_Symbol)
+         Nkind (E2) in N_Identifier | N_Operator_Symbol
       then
          return Chars (E1) = Chars (E2);
 
-      elsif Nkind_In (E1, N_Selected_Component, N_Expanded_Name)
+      elsif Nkind (E1) in N_Selected_Component | N_Expanded_Name
               and then
-            Nkind_In (E2, N_Selected_Component, N_Expanded_Name)
+            Nkind (E2) in N_Selected_Component | N_Expanded_Name
       then
          return Same_Unit (Prefix (E1), Prefix (E2))
                   and then
@@ -1422,9 +1285,9 @@ package body Restrict is
       if Nkind (U1) = N_Identifier and then Nkind (U2) = N_Identifier then
          return Chars (U1) = Chars (U2);
 
-      elsif Nkind_In (U1, N_Selected_Component, N_Expanded_Name)
+      elsif Nkind (U1) in N_Selected_Component | N_Expanded_Name
               and then
-            Nkind_In (U2, N_Selected_Component, N_Expanded_Name)
+            Nkind (U2) in N_Selected_Component | N_Expanded_Name
       then
          return Same_Unit (Prefix (U1), Prefix (U2))
                   and then
@@ -1444,17 +1307,6 @@ package body Restrict is
    end Save_Config_Cunit_Boolean_Restrictions;
 
    ------------------------------
-   -- Set_Hidden_Part_In_SPARK --
-   ------------------------------
-
-   procedure Set_Hidden_Part_In_SPARK (Loc1, Loc2 : Source_Ptr) is
-   begin
-      SPARK_Hides.Increment_Last;
-      SPARK_Hides.Table (SPARK_Hides.Last).Start := Loc1;
-      SPARK_Hides.Table (SPARK_Hides.Last).Stop  := Loc2;
-   end Set_Hidden_Part_In_SPARK;
-
-   ------------------------------
    -- Set_Profile_Restrictions --
    ------------------------------
 
@@ -1502,8 +1354,6 @@ package body Restrict is
    -- Set_Restriction --
    ---------------------
 
-   --  Case of Boolean restriction
-
    procedure Set_Restriction
      (R : All_Boolean_Restrictions;
       N : Node_Id)
@@ -1543,8 +1393,6 @@ package body Restrict is
       end if;
    end Set_Restriction;
 
-   --  Case of parameter restriction
-
    procedure Set_Restriction
      (R : All_Parameter_Restrictions;
       N : Node_Id;
@@ -1594,6 +1442,29 @@ package body Restrict is
       Restriction_Profile_Name (R) := No_Profile;
    end Set_Restriction;
 
+   procedure Set_Restriction
+     (R    : All_Restrictions;
+      N    : Node_Id;
+      Warn : Boolean;
+      V    : Integer := Integer'First)
+   is
+      Set : Boolean := True;
+   begin
+      if Warn and then Restriction_Active (R) then
+         Set := False;
+      end if;
+
+      if Set then
+         if R in All_Boolean_Restrictions then
+            Set_Restriction (R, N);
+         else
+            Set_Restriction (R, N, V);
+         end if;
+
+         Restriction_Warnings (R) := Warn;
+      end if;
+   end Set_Restriction;
+
    -----------------------------------
    -- Set_Restriction_No_Dependence --
    -----------------------------------
@@ -1633,7 +1504,7 @@ package body Restrict is
 
    procedure Set_Restriction_No_Use_Of_Entity
      (Entity  : Node_Id;
-      Warning : Boolean;
+      Warn    : Boolean;
       Profile : Profile_Name := No_Profile)
    is
       Nam : Node_Id;
@@ -1649,7 +1520,7 @@ package body Restrict is
 
             --  Error has precedence over warning
 
-            if not Warning then
+            if not Warn then
                No_Use_Of_Entity.Table (J).Warn := False;
             end if;
 
@@ -1659,17 +1530,17 @@ package body Restrict is
 
       --  Entry is not currently in table
 
-      No_Use_Of_Entity.Append ((Entity, Warning, Profile));
+      No_Use_Of_Entity.Append ((Entity, Warn, Profile));
 
       --  Now we need to find the direct name and set Boolean2 flag
 
-      if Nkind_In (Entity, N_Identifier, N_Operator_Symbol) then
+      if Nkind (Entity) in N_Identifier | N_Operator_Symbol then
          Nam := Entity;
 
       else
          pragma Assert (Nkind (Entity) = N_Selected_Component);
          Nam := Selector_Name (Entity);
-         pragma Assert (Nkind_In (Nam, N_Identifier, N_Operator_Symbol));
+         pragma Assert (Nkind (Nam) in N_Identifier | N_Operator_Symbol);
       end if;
 
       Set_Name_Table_Boolean2 (Chars (Nam), True);
@@ -1680,15 +1551,15 @@ package body Restrict is
    ------------------------------------------------
 
    procedure Set_Restriction_No_Specification_Of_Aspect
-     (N       : Node_Id;
-      Warning : Boolean)
+     (N    : Node_Id;
+      Warn : Boolean)
    is
       A_Id : constant Aspect_Id_Exclude_No_Aspect := Get_Aspect_Id (Chars (N));
 
    begin
       No_Specification_Of_Aspect_Set := True;
       No_Specification_Of_Aspects (A_Id) := Sloc (N);
-      No_Specification_Of_Aspect_Warning (A_Id) := Warning;
+      No_Specification_Of_Aspect_Warning (A_Id) := Warn;
    end Set_Restriction_No_Specification_Of_Aspect;
 
    procedure Set_Restriction_No_Specification_Of_Aspect (A_Id : Aspect_Id) is
@@ -1703,15 +1574,15 @@ package body Restrict is
    -----------------------------------------
 
    procedure Set_Restriction_No_Use_Of_Attribute
-     (N       : Node_Id;
-      Warning : Boolean)
+     (N    : Node_Id;
+      Warn : Boolean)
    is
       A_Id : constant Attribute_Id := Get_Attribute_Id (Chars (N));
 
    begin
       No_Use_Of_Attribute_Set := True;
       No_Use_Of_Attribute (A_Id) := Sloc (N);
-      No_Use_Of_Attribute_Warning (A_Id) := Warning;
+      No_Use_Of_Attribute_Warning (A_Id) := Warn;
    end Set_Restriction_No_Use_Of_Attribute;
 
    procedure Set_Restriction_No_Use_Of_Attribute (A_Id : Attribute_Id) is
@@ -1726,15 +1597,15 @@ package body Restrict is
    --------------------------------------
 
    procedure Set_Restriction_No_Use_Of_Pragma
-     (N       : Node_Id;
-      Warning : Boolean)
+     (N    : Node_Id;
+      Warn : Boolean)
    is
       A_Id : constant Pragma_Id := Get_Pragma_Id (Chars (N));
 
    begin
       No_Use_Of_Pragma_Set := True;
       No_Use_Of_Pragma (A_Id) := Sloc (N);
-      No_Use_Of_Pragma_Warning (A_Id) := Warning;
+      No_Use_Of_Pragma_Warning (A_Id) := Warn;
    end Set_Restriction_No_Use_Of_Pragma;
 
    procedure Set_Restriction_No_Use_Of_Pragma (A_Id : Pragma_Id) is
@@ -1744,6 +1615,15 @@ package body Restrict is
       No_Use_Of_Pragma_Warning (A_Id) := False;
    end Set_Restriction_No_Use_Of_Pragma;
 
+   ---------------------------
+   -- Set_Global_No_Tasking --
+   ---------------------------
+
+   procedure Set_Global_No_Tasking is
+   begin
+      Global_Restriction_No_Tasking := True;
+   end Set_Global_No_Tasking;
+
    ----------------------------------
    -- Suppress_Restriction_Message --
    ----------------------------------