2011-12-05 Bob Duff <duff@adacore.com>

[pf3gnuchains/gcc-fork.git] / gcc / ada / einfo.adb

diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index dbe5c26..4cbd4c5 100644 (file)
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -161,6 +161,7 @@ package body Einfo is
 
    --    Body_Entity                     Node19
    --    Corresponding_Discriminant      Node19
+   --    Extra_Accessibility_Of_Result   Node19
    --    Parent_Subtype                  Node19
    --    Related_Array_Object            Node19
    --    Size_Check_Code                 Node19
@@ -522,8 +523,7 @@ package body Einfo is
    --    Has_Implicit_Dereference        Flag251
    --    Is_Processed_Transient          Flag252
    --    Has_Anonymous_Master            Flag253
-
-   --    (unused)                        Flag254
+   --    Is_Implementation_Defined       Flag254
 
    -----------------------
    -- Local subprograms --
@@ -1043,6 +1043,12 @@ package body Einfo is
       return Node13 (Id);
    end Extra_Accessibility;
 
+   function Extra_Accessibility_Of_Result (Id : E) return E is
+   begin
+      pragma Assert (Ekind_In (Id, E_Function, E_Operator, E_Subprogram_Type));
+      return Node19 (Id);
+   end Extra_Accessibility_Of_Result;
+
    function Extra_Constrained (Id : E) return E is
    begin
       pragma Assert (Is_Formal (Id) or else Ekind (Id) = E_Variable);
@@ -1599,7 +1605,7 @@ package body Einfo is
 
    function Has_Xref_Entry (Id : E) return B is
    begin
-      return Flag182 (Implementation_Base_Type (Id));
+      return Flag182 (Id);
    end Has_Xref_Entry;
 
    function Hiding_Loop_Variable (Id : E) return E is
@@ -1873,6 +1879,11 @@ package body Einfo is
       return Flag7 (Id);
    end Is_Immediately_Visible;
 
+   function Is_Implementation_Defined (Id : E) return B is
+   begin
+      return Flag254 (Id);
+   end Is_Implementation_Defined;
+
    function Is_Imported (Id : E) return B is
    begin
       return Flag24 (Id);
@@ -3519,6 +3530,12 @@ package body Einfo is
       Set_Node13 (Id, V);
    end Set_Extra_Accessibility;
 
+   procedure Set_Extra_Accessibility_Of_Result (Id : E; V : E) is
+   begin
+      pragma Assert (Ekind_In (Id, E_Function, E_Operator, E_Subprogram_Type));
+      Set_Node19 (Id, V);
+   end Set_Extra_Accessibility_Of_Result;
+
    procedure Set_Extra_Constrained (Id : E; V : E) is
    begin
       pragma Assert (Is_Formal (Id) or else Ekind (Id) = E_Variable);
@@ -4395,6 +4412,11 @@ package body Einfo is
       Set_Flag7 (Id, V);
    end Set_Is_Immediately_Visible;
 
+   procedure Set_Is_Implementation_Defined (Id : E; V : B := True) is
+   begin
+      Set_Flag254 (Id, V);
+   end Set_Is_Implementation_Defined;
+
    procedure Set_Is_Imported (Id : E; V : B := True) is
    begin
       Set_Flag24 (Id, V);
@@ -7551,6 +7573,7 @@ package body Einfo is
       W ("Is_Hidden",                       Flag57  (Id));
       W ("Is_Hidden_Open_Scope",            Flag171 (Id));
       W ("Is_Immediately_Visible",          Flag7   (Id));
+      W ("Is_Implementation_Defined",       Flag254 (Id));
       W ("Is_Imported",                     Flag24  (Id));
       W ("Is_Inlined",                      Flag11  (Id));
       W ("Is_Instantiated",                 Flag126 (Id));
@@ -8312,6 +8335,9 @@ package body Einfo is
          when Private_Kind                                 =>
             Write_Str ("Underlying_Full_View");
 
+         when E_Function | E_Operator | E_Subprogram_Type =>
+            Write_Str ("Extra_Accessibility_Of_Result");
+
          when others                                       =>
             Write_Str ("Field19??");
       end case;
@@ -8686,9 +8712,12 @@ package body Einfo is
    procedure Write_Field28_Name (Id : Entity_Id) is
    begin
       case Ekind (Id) is
-         when E_Procedure                                  |
+         when E_Entry                                      |
+              E_Entry_Family                               |
               E_Function                                   |
-              E_Entry                                      =>
+              E_Procedure                                  |
+              E_Subprogram_Body                            |
+              E_Subprogram_Type                            =>
             Write_Str ("Extra_Formals");
 
          when E_Record_Type =>