2013-04-11 Robert Dewar <dewar@adacore.com>

	* exp_attr.adb, sem_res.adb, sem_attr.adb: Minor reformatting.

2013-04-11  Robert Dewar  <dewar@adacore.com>

	* atree.adb, atree.ads (Node31): New function.
	(Set_Node31): New procedure.

2013-04-11  Robert Dewar  <dewar@adacore.com>

	* errout.ads: Minor typo correction.

2013-04-11  Javier Miranda  <miranda@adacore.com>

	* einfo.ad[sb] (Thunk_Entity/Set_Thunk_Entity): New attribute.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@197792 138bc75d-0d04-0410-961f-82ee72b054a4

9 files changed, 78 insertions, 20 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 848a94540df..3e584e9a6f1 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,22 @@
 2013-04-11  Robert Dewar  <dewar@adacore.com>
 
+	* exp_attr.adb, sem_res.adb, sem_attr.adb: Minor reformatting.
+
+2013-04-11  Robert Dewar  <dewar@adacore.com>
+
+	* atree.adb, atree.ads (Node31): New function.
+	(Set_Node31): New procedure.
+
+2013-04-11  Robert Dewar  <dewar@adacore.com>
+
+	* errout.ads: Minor typo correction.
+
+2013-04-11  Javier Miranda  <miranda@adacore.com>
+
+	* einfo.ad[sb] (Thunk_Entity/Set_Thunk_Entity): New attribute.
+
+2013-04-11  Robert Dewar  <dewar@adacore.com>
+
 	* back_end.adb (Register_Back_End_Types): Moved to Get_Targ
 	* back_end.ads (C_String): Moved to Get_Targ
 	(Register_Type_Proc): Moved to Get_Targ (Register_Back_End_Types):
diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb
index b287b57302d..40a27a1fb74 100644
--- a/gcc/ada/atree.adb
+++ b/gcc/ada/atree.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2013, 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- --
@@ -2526,6 +2526,12 @@ package body Atree is
          return Node_Id (Nodes.Table (N + 5).Field6);
       end Node30;
 
+      function Node31 (N : Node_Id) return Node_Id is
+      begin
+         pragma Assert (Nkind (N) in N_Entity);
+         return Node_Id (Nodes.Table (N + 5).Field7);
+      end Node31;
+
       function List1 (N : Node_Id) return List_Id is
       begin
          pragma Assert (N <= Nodes.Last);
@@ -5231,6 +5237,12 @@ package body Atree is
          Nodes.Table (N + 5).Field6 := Union_Id (Val);
       end Set_Node30;
 
+      procedure Set_Node31 (N : Node_Id; Val : Node_Id) is
+      begin
+         pragma Assert (Nkind (N) in N_Entity);
+         Nodes.Table (N + 5).Field7 := Union_Id (Val);
+      end Set_Node31;
+
       procedure Set_List1 (N : Node_Id; Val : List_Id) is
       begin
          pragma Assert (N <= Nodes.Last);
diff --git a/gcc/ada/atree.ads b/gcc/ada/atree.ads
index fc60293d65b..07e8e512a57 100644
--- a/gcc/ada/atree.ads
+++ b/gcc/ada/atree.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2013, 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- --
@@ -1171,6 +1171,9 @@ package Atree is
       function Node30 (N : Node_Id) return Node_Id;
       pragma Inline (Node30);
 
+      function Node31 (N : Node_Id) return Node_Id;
+      pragma Inline (Node31);
+
       function List1 (N : Node_Id) return List_Id;
       pragma Inline (List1);
 
@@ -2453,6 +2456,9 @@ package Atree is
       procedure Set_Node30 (N : Node_Id; Val : Node_Id);
       pragma Inline (Set_Node30);
 
+      procedure Set_Node31 (N : Node_Id; Val : Node_Id);
+      pragma Inline (Set_Node31);
+
       procedure Set_List1 (N : Node_Id; Val : List_Id);
       pragma Inline (Set_List1);
 
diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index cd384516b18..3d88294006c 100644
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -245,7 +245,7 @@ package body Einfo is
    --    Corresponding_Equality          Node30
    --    Static_Initialization           Node30
 
-   --    (unused)                        Node31
+   --    Thunk_Entity                    Node31
 
    --    (unused)                        Node32
 
@@ -2907,6 +2907,13 @@ package body Einfo is
       return Node25 (Id);
    end Task_Body_Procedure;
 
+   function Thunk_Entity (Id : E) return E is
+   begin
+      pragma Assert (Ekind_In (Id, E_Function, E_Procedure)
+                      and then Is_Thunk (Id));
+      return Node31 (Id);
+   end Thunk_Entity;
+
    function Treat_As_Volatile (Id : E) return B is
    begin
       return Flag41 (Id);
@@ -5539,6 +5546,13 @@ package body Einfo is
       Set_Node25 (Id, V);
    end Set_Task_Body_Procedure;
 
+   procedure Set_Thunk_Entity (Id : E; V : E) is
+   begin
+      pragma Assert (Ekind_In (Id, E_Function, E_Procedure)
+                       and then Is_Thunk (Id));
+      Set_Node31 (Id, V);
+   end Set_Thunk_Entity;
+
    procedure Set_Treat_As_Volatile (Id : E; V : B := True) is
    begin
       Set_Flag41 (Id, V);
@@ -8959,7 +8973,8 @@ package body Einfo is
               E_Variable                                   =>
             Write_Str ("Related_Type");
 
-         when E_Procedure                                  =>
+         when E_Procedure                                  |
+              E_Function                                   =>
             Write_Str ("Wrapped_Entity");
 
          when others                                       =>
@@ -9033,6 +9048,10 @@ package body Einfo is
    procedure Write_Field31_Name (Id : Entity_Id) is
    begin
       case Ekind (Id) is
+         when E_Procedure                                  |
+              E_Function                                   =>
+            Write_Str ("Thunk_Entity");
+
          when others                                       =>
             Write_Str ("Field31??");
       end case;
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 9d57278b11b..70646f37442 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -3853,6 +3853,10 @@ package Einfo is
 --       The last sentence is odd??? Why not have Task_Body_Procedure go to the
 --       Underlying_Type of the Root_Type???
 
+--    Thunk_Entity (Node31)
+--       Defined in functions and procedures which have been classified as
+--       Is_Thunk. Set to the target entity called by the thunk.
+
 --    Treat_As_Volatile (Flag41)
 --       Defined in all type entities, and also in constants, components and
 --       variables. Set if this entity is to be treated as volatile for code
@@ -5358,6 +5362,7 @@ package Einfo is
    --    Extra_Formals                       (Node28)
    --    Subprograms_For_Type                (Node29)
    --    Corresponding_Equality              (Node30)   (implicit /= only)
+   --    Thunk_Entity                        (Node31)   (thunk case only)
    --    Body_Needed_For_SAL                 (Flag40)
    --    Elaboration_Entity_Required         (Flag174)
    --    Default_Expressions_Processed       (Flag108)
@@ -5628,6 +5633,7 @@ package Einfo is
    --    Wrapped_Entity                      (Node27)   (non-generic case only)
    --    Extra_Formals                       (Node28)
    --    Static_Initialization               (Node30)   (init_proc only)
+   --    Thunk_Entity                        (Node31)   (thunk case only)
    --    Body_Needed_For_SAL                 (Flag40)
    --    Delay_Cleanups                      (Flag114)
    --    Discard_Names                       (Flag88)
@@ -6502,6 +6508,7 @@ package Einfo is
    function Suppress_Style_Checks               (Id : E) return B;
    function Suppress_Value_Tracking_On_Call     (Id : E) return B;
    function Task_Body_Procedure                 (Id : E) return N;
+   function Thunk_Entity                        (Id : E) return E;
    function Treat_As_Volatile                   (Id : E) return B;
    function Underlying_Full_View                (Id : E) return E;
    function Underlying_Record_View              (Id : E) return E;
@@ -7112,6 +7119,7 @@ package Einfo is
    procedure Set_Suppress_Style_Checks           (Id : E; V : B := True);
    procedure Set_Suppress_Value_Tracking_On_Call (Id : E; V : B := True);
    procedure Set_Task_Body_Procedure             (Id : E; V : N);
+   procedure Set_Thunk_Entity                    (Id : E; V : E);
    procedure Set_Treat_As_Volatile               (Id : E; V : B := True);
    procedure Set_Underlying_Full_View            (Id : E; V : E);
    procedure Set_Underlying_Record_View          (Id : E; V : E);
@@ -7850,6 +7858,7 @@ package Einfo is
    pragma Inline (Suppress_Style_Checks);
    pragma Inline (Suppress_Value_Tracking_On_Call);
    pragma Inline (Task_Body_Procedure);
+   pragma Inline (Thunk_Entity);
    pragma Inline (Treat_As_Volatile);
    pragma Inline (Underlying_Full_View);
    pragma Inline (Underlying_Record_View);
@@ -8261,6 +8270,7 @@ package Einfo is
    pragma Inline (Set_Suppress_Style_Checks);
    pragma Inline (Set_Suppress_Value_Tracking_On_Call);
    pragma Inline (Set_Task_Body_Procedure);
+   pragma Inline (Set_Thunk_Entity);
    pragma Inline (Set_Treat_As_Volatile);
    pragma Inline (Set_Underlying_Full_View);
    pragma Inline (Set_Underlying_Record_View);
diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads
index 1e95b173f5a..f53c3e032cd 100644
--- a/gcc/ada/errout.ads
+++ b/gcc/ada/errout.ads
@@ -222,7 +222,7 @@ package Errout is
    --      A second ^ may occur in the message, in which case it is replaced
    --      by the decimal conversion of the Uint value in Error_Msg_Uint_2.
 
-   --    Insertion character > (Right bracket, run time name)
+   --    Insertion character > (Greater Than, run time name)
    --      The character > is replaced by a string of the form (name) if
    --      Targparm scanned out a Run_Time_Name (see package Targparm for
    --      details). The name is enclosed in parentheses and output in mixed
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 55d45b706f1..a55a32ccd7b 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -1069,9 +1069,7 @@ package body Exp_Attr is
 
                         begin
                            Subp := Current_Scope;
-                           while Ekind (Subp) = E_Loop
-                             or else Ekind (Subp) = E_Block
-                           loop
+                           while Ekind_In (Subp, E_Loop, E_Block) loop
                               Subp := Scope (Subp);
                            end loop;
 
@@ -1095,8 +1093,8 @@ package body Exp_Attr is
                                 Unchecked_Convert_To (Typ,
                                   Make_Attribute_Reference (Loc,
                                     Attribute_Name => Name_Unrestricted_Access,
-                                    Prefix =>
-                                       New_Occurrence_Of (Formal, Loc))));
+                                    Prefix         =>
+                                      New_Occurrence_Of (Formal, Loc))));
                               Analyze_And_Resolve (N);
                            end if;
                         end;
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 50e55f9812d..4b1845ae930 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -10051,9 +10051,7 @@ package body Sem_Attr is
          --  then this is only legal within a task or protected record.
 
          when others =>
-            if not Is_Entity_Name (P)
-              or else not Is_Type (Entity (P))
-            then
+            if not Is_Entity_Name (P) or else not Is_Type (Entity (P)) then
                Resolve (P);
             end if;
 
@@ -10061,9 +10059,7 @@ package body Sem_Attr is
             --  'Class) then this is only legal within a task or protected
             --  record. What is this all about ???
 
-            if Is_Entity_Name (N)
-              and then Is_Type (Entity (N))
-            then
+            if Is_Entity_Name (N) and then Is_Type (Entity (N)) then
                if Is_Concurrent_Type (Entity (N))
                  and then In_Open_Scopes (Entity (P))
                then
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index a612fa84d8f..804f3b81997 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -6859,13 +6859,13 @@ package body Sem_Res is
          S   : Entity_Id;
 
       begin
-         if Ekind (Etype (R)) =  E_Allocator_Type
-           or else Ekind (Etype (R)) = E_Access_Attribute_Type
+         if Ekind_In (Etype (R), E_Allocator_Type,
+                                 E_Access_Attribute_Type)
          then
             Acc := Designated_Type (Etype (R));
 
-         elsif Ekind (Etype (L)) =  E_Allocator_Type
-           or else Ekind (Etype (L)) = E_Access_Attribute_Type
+         elsif Ekind_In (Etype (L), E_Allocator_Type,
+                                    E_Access_Attribute_Type)
          then
             Acc := Designated_Type (Etype (L));
          else