obtained gcc-4.6.4.tar.bz2 from upstream website;upstream

verified gcc-4.6.4.tar.bz2.sig;
imported gcc-4.6.4 source tree from verified upstream tarball.

downloading a git-generated archive based on the 'upstream' tag
should provide you with a source tree that is binary identical
to the one extracted from the above tarball.

if you have obtained the source via the command 'git clone',
however, do note that line-endings of files in your working
directory might differ from line-endings of the respective
files in the upstream repository.

1 files changed, 994 insertions, 0 deletions

diff --git a/gcc/ada/restrict.adb b/gcc/ada/restrict.adb
new file mode 100644
index 000000000..755aabc15
--- /dev/null
+++ b/gcc/ada/restrict.adb
@@ -0,0 +1,994 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                             R E S T R I C T                              --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--          Copyright (C) 1992-2010, 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- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+-- for  more details.  You should have  received  a copy of the GNU General --
+-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
+-- http://www.gnu.org/licenses for a complete copy of the license.          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with Atree;    use Atree;
+with Casing;   use Casing;
+with Einfo;    use Einfo;
+with Errout;   use Errout;
+with Debug;    use Debug;
+with Fname;    use Fname;
+with Fname.UF; use Fname.UF;
+with Lib;      use Lib;
+with Opt;      use Opt;
+with Sinfo;    use Sinfo;
+with Sinput;   use Sinput;
+with Snames;   use Snames;
+with Stand;    use Stand;
+with Uname;    use Uname;
+
+package body Restrict is
+
+   Restricted_Profile_Result : Boolean := False;
+   --  This switch memoizes the result of Restricted_Profile function
+   --  calls for improved efficiency. Its setting is valid only if
+   --  Restricted_Profile_Cached is True. Note that if this switch
+   --  is ever set True, it need never be turned off again.
+
+   Restricted_Profile_Cached : Boolean := False;
+   --  This flag is set to True if the Restricted_Profile_Result
+   --  contains the correct cached result of Restricted_Profile calls.
+
+   -----------------------
+   -- Local Subprograms --
+   -----------------------
+
+   procedure Restriction_Msg (R : Restriction_Id; N : Node_Id);
+   --  Called if a violation of restriction R at node N is found. This routine
+   --  outputs the appropriate message or messages taking care of warning vs
+   --  real violation, serious vs non-serious, implicit vs explicit, the second
+   --  message giving the profile name if needed, and the location information.
+
+   function Same_Unit (U1, U2 : Node_Id) return Boolean;
+   --  Returns True iff U1 and U2 represent the same library unit. Used for
+   --  handling of No_Dependence => Unit restriction case.
+
+   function Suppress_Restriction_Message (N : Node_Id) return Boolean;
+   --  N is the node for a possible restriction violation message, but the
+   --  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.
+
+   -------------------
+   -- Abort_Allowed --
+   -------------------
+
+   function Abort_Allowed return Boolean is
+   begin
+      if Restrictions.Set (No_Abort_Statements)
+        and then Restrictions.Set (Max_Asynchronous_Select_Nesting)
+        and then Restrictions.Value (Max_Asynchronous_Select_Nesting) = 0
+      then
+         return False;
+      else
+         return True;
+      end if;
+   end Abort_Allowed;
+
+   -------------------------
+   -- Check_Compiler_Unit --
+   -------------------------
+
+   procedure Check_Compiler_Unit (N : Node_Id) is
+   begin
+      if Is_Compiler_Unit (Get_Source_Unit (N)) then
+         Error_Msg_N ("use of construct not allowed in compiler", N);
+      end if;
+   end Check_Compiler_Unit;
+
+   ------------------------------------
+   -- Check_Elaboration_Code_Allowed --
+   ------------------------------------
+
+   procedure Check_Elaboration_Code_Allowed (N : Node_Id) is
+   begin
+      Check_Restriction (No_Elaboration_Code, N);
+   end Check_Elaboration_Code_Allowed;
+
+   -----------------------------------------
+   -- Check_Implicit_Dynamic_Code_Allowed --
+   -----------------------------------------
+
+   procedure Check_Implicit_Dynamic_Code_Allowed (N : Node_Id) is
+   begin
+      Check_Restriction (No_Implicit_Dynamic_Code, N);
+   end Check_Implicit_Dynamic_Code_Allowed;
+
+   ----------------------------------
+   -- Check_No_Implicit_Heap_Alloc --
+   ----------------------------------
+
+   procedure Check_No_Implicit_Heap_Alloc (N : Node_Id) is
+   begin
+      Check_Restriction (No_Implicit_Heap_Allocations, N);
+   end Check_No_Implicit_Heap_Alloc;
+
+   -----------------------------------
+   -- Check_Obsolescent_2005_Entity --
+   -----------------------------------
+
+   procedure Check_Obsolescent_2005_Entity (E : Entity_Id; N : Node_Id) is
+      function Chars_Is (E : Entity_Id; S : String) return Boolean;
+      --  Return True iff Chars (E) matches S (given in lower case)
+
+      function Chars_Is (E : Entity_Id; S : String) return Boolean is
+         Nam : constant Name_Id := Chars (E);
+      begin
+         if Length_Of_Name (Nam) /= S'Length then
+            return False;
+         else
+            return Get_Name_String (Nam) = S;
+         end if;
+      end Chars_Is;
+
+   --  Start of processing for Check_Obsolescent_2005_Entity
+
+   begin
+      if Restriction_Check_Required (No_Obsolescent_Features)
+        and then Ada_Version >= Ada_2005
+        and then Chars_Is (Scope (E),                 "handling")
+        and then Chars_Is (Scope (Scope (E)),         "characters")
+        and then Chars_Is (Scope (Scope (Scope (E))), "ada")
+        and then Scope (Scope (Scope (Scope (E)))) = Standard_Standard
+      then
+         if Chars_Is (E, "is_character")      or else
+            Chars_Is (E, "is_string")         or else
+            Chars_Is (E, "to_character")      or else
+            Chars_Is (E, "to_string")         or else
+            Chars_Is (E, "to_wide_character") or else
+            Chars_Is (E, "to_wide_string")
+         then
+            Check_Restriction (No_Obsolescent_Features, N);
+         end if;
+      end if;
+   end Check_Obsolescent_2005_Entity;
+
+   ---------------------------
+   -- Check_Restricted_Unit --
+   ---------------------------
+
+   procedure Check_Restricted_Unit (U : Unit_Name_Type; N : Node_Id) is
+   begin
+      if Suppress_Restriction_Message (N) then
+         return;
+
+      elsif Is_Spec_Name (U) then
+         declare
+            Fnam : constant File_Name_Type :=
+                     Get_File_Name (U, Subunit => False);
+
+         begin
+            --  Get file name
+
+            Get_Name_String (Fnam);
+
+            --  Nothing to do if name not at least 5 characters long ending
+            --  in .ads or .adb extension, which we strip.
+
+            if Name_Len < 5
+              or else (Name_Buffer (Name_Len - 3 .. Name_Len) /= ".ads"
+                         and then
+                       Name_Buffer (Name_Len - 3 .. Name_Len) /= ".adb")
+            then
+               return;
+            end if;
+
+            --  Strip extension and pad to eight characters
+
+            Name_Len := Name_Len - 4;
+            Add_Str_To_Name_Buffer ((Name_Len + 1 .. 8 => ' '));
+
+            --  If predefined unit, check the list of restricted units
+
+            if Is_Predefined_File_Name (Fnam) then
+               for J in Unit_Array'Range loop
+                  if Name_Len = 8
+                    and then Name_Buffer (1 .. 8) = Unit_Array (J).Filenm
+                  then
+                     Check_Restriction (Unit_Array (J).Res_Id, N);
+                  end if;
+               end loop;
+
+               --  If not predefined unit, then one special check still
+               --  remains. GNAT.Current_Exception is not allowed if we have
+               --  restriction No_Exception_Propagation active.
+
+            else
+               if Name_Buffer (1 .. 8) = "g-curexc" then
+                  Check_Restriction (No_Exception_Propagation, N);
+               end if;
+            end if;
+         end;
+      end if;
+   end Check_Restricted_Unit;
+
+   -----------------------
+   -- Check_Restriction --
+   -----------------------
+
+   procedure Check_Restriction
+     (R : Restriction_Id;
+      N : Node_Id;
+      V : Uint := Uint_Minus_1)
+   is
+      VV : Integer;
+      --  V converted to integer form. If V is greater than Integer'Last,
+      --  it is reset to minus 1 (unknown value).
+
+      procedure Update_Restrictions (Info : in out Restrictions_Info);
+      --  Update violation information in Info.Violated and Info.Count
+
+      -------------------------
+      -- Update_Restrictions --
+      -------------------------
+
+      procedure Update_Restrictions (Info : in out Restrictions_Info) is
+      begin
+         --  If not violated, set as violated now
+
+         if not Info.Violated (R) then
+            Info.Violated (R) := True;
+
+            if R in All_Parameter_Restrictions then
+               if VV < 0 then
+                  Info.Unknown (R) := True;
+                  Info.Count (R) := 1;
+               else
+                  Info.Count (R) := VV;
+               end if;
+            end if;
+
+         --  Otherwise if violated already and a parameter restriction,
+         --  update count by maximizing or summing depending on restriction.
+
+         elsif R in All_Parameter_Restrictions then
+
+            --  If new value is unknown, result is unknown
+
+            if VV < 0 then
+               Info.Unknown (R) := True;
+
+            --  If checked by maximization, do maximization
+
+            elsif R in Checked_Max_Parameter_Restrictions then
+               Info.Count (R) := Integer'Max (Info.Count (R), VV);
+
+            --  If checked by adding, do add, checking for overflow
+
+            elsif R in Checked_Add_Parameter_Restrictions then
+               declare
+                  pragma Unsuppress (Overflow_Check);
+               begin
+                  Info.Count (R) := Info.Count (R) + VV;
+               exception
+                  when Constraint_Error =>
+                     Info.Count (R) := Integer'Last;
+                     Info.Unknown (R) := True;
+               end;
+
+            --  Should not be able to come here, known counts should only
+            --  occur for restrictions that are Checked_max or Checked_Sum.
+
+            else
+               raise Program_Error;
+            end if;
+         end if;
+      end Update_Restrictions;
+
+   --  Start of processing for Check_Restriction
+
+   begin
+      --  In CodePeer mode, we do not want to check for any restriction, or set
+      --  additional restrictions other than those already set in gnat1drv.adb
+      --  so that we have consistency between each compilation.
+
+      if CodePeer_Mode then
+         return;
+      end if;
+
+      if UI_Is_In_Int_Range (V) then
+         VV := Integer (UI_To_Int (V));
+      else
+         VV := -1;
+      end if;
+
+      --  Count can only be specified in the checked val parameter case
+
+      pragma Assert (VV < 0 or else R in Checked_Val_Parameter_Restrictions);
+
+      --  Nothing to do if value of zero specified for parameter restriction
+
+      if VV = 0 then
+         return;
+      end if;
+
+      --  Update current restrictions
+
+      Update_Restrictions (Restrictions);
+
+      --  If in main extended unit, update main restrictions as well
+
+      if Current_Sem_Unit = Main_Unit
+        or else In_Extended_Main_Source_Unit (N)
+      then
+         Update_Restrictions (Main_Restrictions);
+      end if;
+
+      --  Nothing to do if restriction message suppressed
+
+      if Suppress_Restriction_Message (N) then
+         null;
+
+      --  If restriction not set, nothing to do
+
+      elsif not Restrictions.Set (R) then
+         null;
+
+      --  Here if restriction set, check for violation (either this is a
+      --  Boolean restriction, or a parameter restriction with a value of
+      --  zero and an unknown count, or a parameter restriction with a
+      --  known value that exceeds the restriction count).
+
+      elsif R in All_Boolean_Restrictions
+        or else (Restrictions.Unknown (R)
+                   and then Restrictions.Value (R) = 0)
+        or else Restrictions.Count (R) > Restrictions.Value (R)
+      then
+         Restriction_Msg (R, N);
+      end if;
+   end Check_Restriction;
+
+   -------------------------------------
+   -- Check_Restriction_No_Dependence --
+   -------------------------------------
+
+   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.
+
+      if not In_Extended_Main_Source_Unit (U) then
+         return;
+      end if;
+
+      --  Loop through entries in No_Dependence table to check each one in turn
+
+      for J in No_Dependence.First .. No_Dependence.Last loop
+         DU := No_Dependence.Table (J).Unit;
+
+         if Same_Unit (U, DU) then
+            Error_Msg_Sloc := Sloc (DU);
+            Error_Msg_Node_1 := DU;
+
+            if No_Dependence.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;
+
+            return;
+         end if;
+      end loop;
+   end Check_Restriction_No_Dependence;
+
+   --------------------------------------
+   -- Check_Wide_Character_Restriction --
+   --------------------------------------
+
+   procedure Check_Wide_Character_Restriction (E : Entity_Id; N : Node_Id) is
+   begin
+      if Restriction_Check_Required (No_Wide_Characters)
+        and then Comes_From_Source (N)
+      then
+         declare
+            T : constant Entity_Id := Root_Type (E);
+         begin
+            if T = Standard_Wide_Character      or else
+               T = Standard_Wide_String         or else
+               T = Standard_Wide_Wide_Character or else
+               T = Standard_Wide_Wide_String
+            then
+               Check_Restriction (No_Wide_Characters, N);
+            end if;
+         end;
+      end if;
+   end Check_Wide_Character_Restriction;
+
+   ----------------------------------------
+   -- Cunit_Boolean_Restrictions_Restore --
+   ----------------------------------------
+
+   procedure Cunit_Boolean_Restrictions_Restore
+     (R : Save_Cunit_Boolean_Restrictions)
+   is
+   begin
+      for J in Cunit_Boolean_Restrictions loop
+         Restrictions.Set (J) := R (J);
+      end loop;
+   end Cunit_Boolean_Restrictions_Restore;
+
+   -------------------------------------
+   -- Cunit_Boolean_Restrictions_Save --
+   -------------------------------------
+
+   function Cunit_Boolean_Restrictions_Save
+     return Save_Cunit_Boolean_Restrictions
+   is
+      R : Save_Cunit_Boolean_Restrictions;
+
+   begin
+      for J in Cunit_Boolean_Restrictions loop
+         R (J) := Restrictions.Set (J);
+         Restrictions.Set (J) := False;
+      end loop;
+
+      return R;
+   end Cunit_Boolean_Restrictions_Save;
+
+   ------------------------
+   -- Get_Restriction_Id --
+   ------------------------
+
+   function Get_Restriction_Id
+     (N : Name_Id) return Restriction_Id
+   is
+   begin
+      Get_Name_String (N);
+      Set_Casing (All_Upper_Case);
+
+      for J in All_Restrictions loop
+         declare
+            S : constant String := Restriction_Id'Image (J);
+         begin
+            if S = Name_Buffer (1 .. Name_Len) then
+               return J;
+            end if;
+         end;
+      end loop;
+
+      return Not_A_Restriction_Id;
+   end Get_Restriction_Id;
+
+   -------------------------------
+   -- No_Exception_Handlers_Set --
+   -------------------------------
+
+   function No_Exception_Handlers_Set return Boolean is
+   begin
+      return (No_Run_Time_Mode or else Configurable_Run_Time_Mode)
+        and then (Restrictions.Set (No_Exception_Handlers)
+                    or else
+                  Restrictions.Set (No_Exception_Propagation));
+   end No_Exception_Handlers_Set;
+
+   -------------------------------------
+   -- No_Exception_Propagation_Active --
+   -------------------------------------
+
+   function No_Exception_Propagation_Active return Boolean is
+   begin
+      return (No_Run_Time_Mode
+               or else Configurable_Run_Time_Mode
+               or else Debug_Flag_Dot_G)
+        and then Restriction_Active (No_Exception_Propagation);
+   end No_Exception_Propagation_Active;
+
+   ----------------------------------
+   -- Process_Restriction_Synonyms --
+   ----------------------------------
+
+   --  Note: body of this function must be coordinated with list of
+   --  renaming declarations in System.Rident.
+
+   function Process_Restriction_Synonyms (N : Node_Id) return Name_Id
+   is
+      Old_Name : constant Name_Id := Chars (N);
+      New_Name : Name_Id;
+
+   begin
+      case Old_Name is
+         when Name_Boolean_Entry_Barriers =>
+            New_Name := Name_Simple_Barriers;
+
+         when Name_Max_Entry_Queue_Depth =>
+            New_Name := Name_Max_Entry_Queue_Length;
+
+         when Name_No_Dynamic_Interrupts =>
+            New_Name := Name_No_Dynamic_Attachment;
+
+         when Name_No_Requeue =>
+            New_Name := Name_No_Requeue_Statements;
+
+         when Name_No_Task_Attributes =>
+            New_Name := Name_No_Task_Attributes_Package;
+
+         when others =>
+            return Old_Name;
+      end case;
+
+      if Warn_On_Obsolescent_Feature then
+         Error_Msg_Name_1 := Old_Name;
+         Error_Msg_N ("restriction identifier % is obsolescent?", N);
+         Error_Msg_Name_1 := New_Name;
+         Error_Msg_N ("|use restriction identifier % instead", N);
+      end if;
+
+      return New_Name;
+   end Process_Restriction_Synonyms;
+
+   ------------------------
+   -- Restricted_Profile --
+   ------------------------
+
+   function Restricted_Profile return Boolean is
+   begin
+      if Restricted_Profile_Cached then
+         return Restricted_Profile_Result;
+
+      else
+         Restricted_Profile_Result := True;
+         Restricted_Profile_Cached := True;
+
+         declare
+            R : Restriction_Flags  renames Profile_Info (Restricted).Set;
+            V : Restriction_Values renames Profile_Info (Restricted).Value;
+         begin
+            for J in R'Range loop
+               if R (J)
+                 and then (Restrictions.Set (J) = False
+                             or else Restriction_Warnings (J)
+                             or else
+                               (J in All_Parameter_Restrictions
+                                  and then Restrictions.Value (J) > V (J)))
+               then
+                  Restricted_Profile_Result := False;
+                  exit;
+               end if;
+            end loop;
+
+            return Restricted_Profile_Result;
+         end;
+      end if;
+   end Restricted_Profile;
+
+   ------------------------
+   -- Restriction_Active --
+   ------------------------
+
+   function Restriction_Active (R : All_Restrictions) return Boolean is
+   begin
+      return Restrictions.Set (R) and then not Restriction_Warnings (R);
+   end Restriction_Active;
+
+   --------------------------------
+   -- Restriction_Check_Required --
+   --------------------------------
+
+   function Restriction_Check_Required (R : All_Restrictions) return Boolean is
+   begin
+      return Restrictions.Set (R);
+   end Restriction_Check_Required;
+
+   ---------------------
+   -- Restriction_Msg --
+   ---------------------
+
+   procedure Restriction_Msg (R : Restriction_Id; N : Node_Id) is
+      Msg : String (1 .. 100);
+      Len : Natural := 0;
+
+      procedure Add_Char (C : Character);
+      --  Append given character to Msg, bumping Len
+
+      procedure Add_Str (S : String);
+      --  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,
+      --  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.
+
+      --------------
+      -- Add_Char --
+      --------------
+
+      procedure Add_Char (C : Character) is
+      begin
+         Len := Len + 1;
+         Msg (Len) := C;
+      end Add_Char;
+
+      -------------
+      -- Add_Str --
+      -------------
+
+      procedure Add_Str (S : String) is
+      begin
+         Msg (Len + 1 .. Len + S'Length) := S;
+         Len := Len + S'Length;
+      end Add_Str;
+
+      -------------
+      -- Id_Case --
+      -------------
+
+      procedure Id_Case (S : String; Quotes : Boolean := True) is
+      begin
+         Name_Buffer (1 .. S'Last) := S;
+         Name_Len := S'Length;
+         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);
+
+         if Quotes then
+            Add_Str ("`~`");
+         else
+            Add_Char ('~');
+         end if;
+      end Id_Case;
+
+   --  Start of processing for Restriction_Msg
+
+   begin
+      --  Set warning message if warning
+
+      if Restriction_Warnings (R) then
+         Add_Char ('?');
+
+      --  If real violation (not warning), then mark it as non-serious unless
+      --  it is a violation of No_Finalization in which case we leave it as a
+      --  serious message, since otherwise we get crashes during attempts to
+      --  expand stuff that is not properly formed due to assumptions made
+      --  about no finalization being present.
+
+      elsif R /= No_Finalization then
+         Add_Char ('|');
+      end if;
+
+      Error_Msg_Sloc := Restrictions_Loc (R);
+
+      --  Set main message, adding implicit if no source location
+
+      if Error_Msg_Sloc > No_Location
+        or else Error_Msg_Sloc = System_Location
+      then
+         Add_Str ("violation of restriction ");
+      else
+         Add_Str ("violation of implicit restriction ");
+         Error_Msg_Sloc := No_Location;
+      end if;
+
+      --  Case of parameterized restriction
+
+      if R in All_Parameter_Restrictions then
+         Add_Char ('`');
+         Id_Case (Restriction_Id'Image (R), Quotes => False);
+         Add_Str (" = ^`");
+         Error_Msg_Uint_1 := UI_From_Int (Int (Restrictions.Value (R)));
+
+      --  Case of boolean restriction
+
+      else
+         Id_Case (Restriction_Id'Image (R));
+      end if;
+
+      --  Case of no secondary profile continuation message
+
+      if Restriction_Profile_Name (R) = No_Profile then
+         if Error_Msg_Sloc /= No_Location then
+            Add_Char ('#');
+         end if;
+
+         Add_Char ('!');
+         Error_Msg_N (Msg (1 .. Len), N);
+
+      --  Case of secondary profile continuation message present
+
+      else
+         Add_Char ('!');
+         Error_Msg_N (Msg (1 .. Len), N);
+
+         Len := 0;
+         Add_Char ('\');
+
+         --  Set as warning if warning case
+
+         if Restriction_Warnings (R) then
+            Add_Char ('?');
+         end if;
+
+         --  Set main message
+
+         Add_Str ("from profile ");
+         Id_Case (Profile_Name'Image (Restriction_Profile_Name (R)));
+
+         --  Add location if we have one
+
+         if Error_Msg_Sloc /= No_Location then
+            Add_Char ('#');
+         end if;
+
+         --  Output unconditional message and we are done
+
+         Add_Char ('!');
+         Error_Msg_N (Msg (1 .. Len), N);
+      end if;
+   end Restriction_Msg;
+
+   ---------------
+   -- Same_Unit --
+   ---------------
+
+   function Same_Unit (U1, U2 : Node_Id) return Boolean is
+   begin
+      if Nkind (U1) = N_Identifier then
+         return Nkind (U2) = N_Identifier and then Chars (U1) = Chars (U2);
+
+      elsif Nkind (U2) = N_Identifier then
+         return False;
+
+      elsif (Nkind (U1) = N_Selected_Component
+             or else Nkind (U1) = N_Expanded_Name)
+        and then
+          (Nkind (U2) = N_Selected_Component
+           or else Nkind (U2) = N_Expanded_Name)
+      then
+         return Same_Unit (Prefix (U1), Prefix (U2))
+           and then Same_Unit (Selector_Name (U1), Selector_Name (U2));
+      else
+         return False;
+      end if;
+   end Same_Unit;
+
+   ------------------------------
+   -- Set_Profile_Restrictions --
+   ------------------------------
+
+   procedure Set_Profile_Restrictions
+     (P    : Profile_Name;
+      N    : Node_Id;
+      Warn : Boolean)
+   is
+      R : Restriction_Flags  renames Profile_Info (P).Set;
+      V : Restriction_Values renames Profile_Info (P).Value;
+
+   begin
+      for J in R'Range loop
+         if R (J) then
+            declare
+               Already_Restricted : constant Boolean := Restriction_Active (J);
+
+            begin
+               --  Set the restriction
+
+               if J in All_Boolean_Restrictions then
+                  Set_Restriction (J, N);
+               else
+                  Set_Restriction (J, N, V (J));
+               end if;
+
+               --  Record that this came from a Profile[_Warnings] restriction
+
+               Restriction_Profile_Name (J) := P;
+
+               --  Set warning flag, except that we do not set the warning
+               --  flag if the restriction was already active and this is
+               --  the warning case. That avoids a warning overriding a real
+               --  restriction, which should never happen.
+
+               if not (Warn and Already_Restricted) then
+                  Restriction_Warnings (J) := Warn;
+               end if;
+            end;
+         end if;
+      end loop;
+   end Set_Profile_Restrictions;
+
+   ---------------------
+   -- Set_Restriction --
+   ---------------------
+
+   --  Case of Boolean restriction
+
+   procedure Set_Restriction
+     (R : All_Boolean_Restrictions;
+      N : Node_Id)
+   is
+   begin
+      --  Restriction No_Elaboration_Code must be enforced on a unit by unit
+      --  basis. Hence, we avoid setting the restriction when processing an
+      --  unit which is not the main one being compiled (or its corresponding
+      --  spec). It can happen, for example, when processing an inlined body
+      --  (the package containing the inlined subprogram is analyzed,
+      --  including its pragma Restrictions).
+
+      --  This seems like a very nasty kludge??? This is not the only per unit
+      --  restriction why is this treated specially ???
+
+      if R = No_Elaboration_Code
+        and then Current_Sem_Unit /= Main_Unit
+        and then Cunit (Current_Sem_Unit) /= Library_Unit (Cunit (Main_Unit))
+      then
+         return;
+      end if;
+
+      Restrictions.Set (R) := True;
+
+      if Restricted_Profile_Cached and Restricted_Profile_Result then
+         null;
+      else
+         Restricted_Profile_Cached := False;
+      end if;
+
+      --  Set location, but preserve location of system restriction for nice
+      --  error msg with run time name.
+
+      if Restrictions_Loc (R) /= System_Location then
+         Restrictions_Loc (R) := Sloc (N);
+      end if;
+
+      --  Note restriction came from restriction pragma, not profile
+
+      Restriction_Profile_Name (R) := No_Profile;
+
+      --  Record the restriction if we are in the main unit, or in the extended
+      --  main unit. The reason that we test separately for Main_Unit is that
+      --  gnat.adc is processed with Current_Sem_Unit = Main_Unit, but nodes in
+      --  gnat.adc do not appear to be in the extended main source unit (they
+      --  probably should do ???)
+
+      if Current_Sem_Unit = Main_Unit
+        or else In_Extended_Main_Source_Unit (N)
+      then
+         if not Restriction_Warnings (R) then
+            Main_Restrictions.Set (R) := True;
+         end if;
+      end if;
+   end Set_Restriction;
+
+   --  Case of parameter restriction
+
+   procedure Set_Restriction
+     (R : All_Parameter_Restrictions;
+      N : Node_Id;
+      V : Integer)
+   is
+   begin
+      if Restricted_Profile_Cached and Restricted_Profile_Result then
+         null;
+      else
+         Restricted_Profile_Cached := False;
+      end if;
+
+      if Restrictions.Set (R) then
+         if V < Restrictions.Value (R) then
+            Restrictions.Value (R) := V;
+            Restrictions_Loc (R) := Sloc (N);
+         end if;
+
+      else
+         Restrictions.Set (R) := True;
+         Restrictions.Value (R) := V;
+         Restrictions_Loc (R) := Sloc (N);
+      end if;
+
+      --  Record the restriction if we are in the main unit, or in the extended
+      --  main unit. The reason that we test separately for Main_Unit is that
+      --  gnat.adc is processed with Current_Sem_Unit = Main_Unit, but nodes in
+      --  gnat.adc do not appear to be the extended main source unit (they
+      --  probably should do ???)
+
+      if Current_Sem_Unit = Main_Unit
+        or else In_Extended_Main_Source_Unit (N)
+      then
+         if Main_Restrictions.Set (R) then
+            if V < Main_Restrictions.Value (R) then
+               Main_Restrictions.Value (R) := V;
+            end if;
+
+         elsif not Restriction_Warnings (R) then
+            Main_Restrictions.Set (R) := True;
+            Main_Restrictions.Value (R) := V;
+         end if;
+      end if;
+
+      --  Note restriction came from restriction pragma, not profile
+
+      Restriction_Profile_Name (R) := No_Profile;
+   end Set_Restriction;
+
+   -----------------------------------
+   -- Set_Restriction_No_Dependence --
+   -----------------------------------
+
+   procedure Set_Restriction_No_Dependence
+     (Unit    : Node_Id;
+      Warn    : Boolean;
+      Profile : Profile_Name := No_Profile)
+   is
+   begin
+      --  Loop to check for duplicate entry
+
+      for J in No_Dependence.First .. No_Dependence.Last loop
+
+         --  Case of entry already in table
+
+         if Same_Unit (Unit, No_Dependence.Table (J).Unit) then
+
+            --  Error has precedence over warning
+
+            if not Warn then
+               No_Dependence.Table (J).Warn := False;
+            end if;
+
+            return;
+         end if;
+      end loop;
+
+      --  Entry is not currently in table
+
+      No_Dependence.Append ((Unit, Warn, Profile));
+   end Set_Restriction_No_Dependence;
+
+   ----------------------------------
+   -- Suppress_Restriction_Message --
+   ----------------------------------
+
+   function Suppress_Restriction_Message (N : Node_Id) return Boolean is
+   begin
+      --  We only output messages for the extended main source unit
+
+      if In_Extended_Main_Source_Unit (N) then
+         return False;
+
+      --  If loaded by rtsfind, then suppress message
+
+      elsif Sloc (N) <= No_Location then
+         return True;
+
+      --  Otherwise suppress message if internal file
+
+      else
+         return Is_Internal_File_Name (Unit_File_Name (Get_Source_Unit (N)));
+      end if;
+   end Suppress_Restriction_Message;
+
+   ---------------------
+   -- Tasking_Allowed --
+   ---------------------
+
+   function Tasking_Allowed return Boolean is
+   begin
+      return not Restrictions.Set (No_Tasking)
+        and then (not Restrictions.Set (Max_Tasks)
+                    or else Restrictions.Value (Max_Tasks) > 0);
+   end Tasking_Allowed;
+
+end Restrict;