[multiple changes]

2015-10-26  Hristian Kirtchev  <kirtchev@adacore.com>

	* atree.ads, atree.adb (Ekind_In): New 10 and 11 parameter versions.
	* contracts.ads, contracts.adb (Analyze_Initial_Declaration_Contract):
	New routine.
	* sem_ch6.adb (Analyze_Generic_Subprogram_Body):
	Analyze the contract of the initial declaration.
	(Analyze_Subprogram_Body_Helper): Analyze the contract of the
	initial declaration.
	* sem_ch7.adb (Analyze_Package_Body_Helper): Analyze the contract
	of the initial declaration.
	* sem_ch9.adb (Analyze_Entry_Body): Analyze the contract of
	the initial declaration.
	(Analyze_Protected_Body): Analyze
	the contract of the initial declaration.
	(Analyze_Task_Body): Analyze the contract of the initial declaration.
	* sem_prag.adb (Add_Entity_To_Name_Buffer): Use "type" rather
	than "unit" as it makes the error messages sound better.
	(Add_Item_To_Name_Buffer): Update comment on usage. The routine
	now supports discriminants and current instances of concurrent
	types.
	(Analyze_Depends_In_Decl_Part): Install the discriminants
	of a task type.
	(Analyze_Global_In_Decl_Part): Install the discriminants of a task type.
	(Analyze_Global_Item): Add processing for current instances of
	concurrent types and include discriminants as valid global items.
	(Analyze_Input_Output): Discriminants and current instances of
	concurrent types are now valid items. Update various error messages.
	(Check_Usage): Current instances of protected and task types behaves
	as formal parameters.
	(Collect_Subprogram_Inputs_Outputs): There is
	no longer need to manually analyze [Refined_]Global thanks to
	freezing of initial declaration contracts.  Add processing for
	the current instance of a concurrent type.
	(Find_Role): Add categorizations for discriminants, protected and task
	types.
	(Is_CCT_Instance): New routine.
	(Match_Items): Update the comment on usage. Update internal comments.
	* sem_prag.ads (Collect_Subprogram_Inputs_Outputs): Update the
	comment on usage.
	* sem_util.adb (Entity_Of): Ensure that the entity is an object
	when traversing a potential renaming chain.
	(Fix_Msg): Use "type" rather than "unit" as it makes the error messages
	sound better.
	* sem_util.ads (Fix_Msg): Update the comment on usage.

2015-10-26  Arnaud Charlet  <charlet@adacore.com>

	* par.adb (Par): Do not generate an error when generating
	SCIL for predefined units or new children of system and co.

2015-10-26  Ed Schonberg  <schonberg@adacore.com>

	* einfo.adb: Access_Disp_Table applies to a private
	extension.

From-SVN: r229373

gcc/ada/ChangeLog

+2015-10-26  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* atree.ads, atree.adb (Ekind_In): New 10 and 11 parameter versions.
+	* contracts.ads, contracts.adb (Analyze_Initial_Declaration_Contract):
+	New routine.
+	* sem_ch6.adb (Analyze_Generic_Subprogram_Body):
+	Analyze the contract of the initial declaration.
+	(Analyze_Subprogram_Body_Helper): Analyze the contract of the
+	initial declaration.
+	* sem_ch7.adb (Analyze_Package_Body_Helper): Analyze the contract
+	of the initial declaration.
+	* sem_ch9.adb (Analyze_Entry_Body): Analyze the contract of
+	the initial declaration.
+	(Analyze_Protected_Body): Analyze
+	the contract of the initial declaration.
+	(Analyze_Task_Body): Analyze the contract of the initial declaration.
+	* sem_prag.adb (Add_Entity_To_Name_Buffer): Use "type" rather
+	than "unit" as it makes the error messages sound better.
+	(Add_Item_To_Name_Buffer): Update comment on usage. The routine
+	now supports discriminants and current instances of concurrent
+	types.
+	(Analyze_Depends_In_Decl_Part): Install the discriminants
+	of a task type.
+	(Analyze_Global_In_Decl_Part): Install the discriminants of a task type.
+	(Analyze_Global_Item): Add processing for current instances of
+	concurrent types and include discriminants as valid global items.
+	(Analyze_Input_Output): Discriminants and current instances of
+	concurrent types are now valid items. Update various error messages.
+	(Check_Usage): Current instances of protected and task types behaves
+	as formal parameters.
+	(Collect_Subprogram_Inputs_Outputs): There is
+	no longer need to manually analyze [Refined_]Global thanks to
+	freezing of initial declaration contracts.  Add processing for
+	the current instance of a concurrent type.
+	(Find_Role): Add categorizations for discriminants, protected and task
+	types.
+	(Is_CCT_Instance): New routine.
+	(Match_Items): Update the comment on usage. Update internal comments.
+	* sem_prag.ads (Collect_Subprogram_Inputs_Outputs): Update the
+	comment on usage.
+	* sem_util.adb (Entity_Of): Ensure that the entity is an object
+	when traversing a potential renaming chain.
+	(Fix_Msg): Use "type" rather than "unit" as it makes the error messages
+	sound better.
+	* sem_util.ads (Fix_Msg): Update the comment on usage.
+
+2015-10-26  Arnaud Charlet  <charlet@adacore.com>
+
+	* par.adb (Par): Do not generate an error when generating
+	SCIL for predefined units or new children of system and co.
+
+2015-10-26  Ed Schonberg  <schonberg@adacore.com>
+
+	* einfo.adb: Access_Disp_Table applies to a private
+	extension.
+
 2015-10-26  Ed Schonberg  <schonberg@adacore.com>
 
 	* sem_res.adb (Resolve_Generalized_Indexing): In ASIS mode, when

gcc/ada/atree.adb

@@ -1126,6 +1126,60 @@ package body Atree is
    end Ekind_In;
 
    function Ekind_In
+     (T   : Entity_Kind;
+      V1  : Entity_Kind;
+      V2  : Entity_Kind;
+      V3  : Entity_Kind;
+      V4  : Entity_Kind;
+      V5  : Entity_Kind;
+      V6  : Entity_Kind;
+      V7  : Entity_Kind;
+      V8  : Entity_Kind;
+      V9  : Entity_Kind;
+      V10 : Entity_Kind) return Boolean
+   is
+   begin
+      return T = V1 or else
+             T = V2 or else
+             T = V3 or else
+             T = V4 or else
+             T = V5 or else
+             T = V6 or else
+             T = V7 or else
+             T = V8 or else
+             T = V9 or else
+             T = V10;
+   end Ekind_In;
+
+   function Ekind_In
+     (T   : Entity_Kind;
+      V1  : Entity_Kind;
+      V2  : Entity_Kind;
+      V3  : Entity_Kind;
+      V4  : Entity_Kind;
+      V5  : Entity_Kind;
+      V6  : Entity_Kind;
+      V7  : Entity_Kind;
+      V8  : Entity_Kind;
+      V9  : Entity_Kind;
+      V10 : Entity_Kind;
+      V11 : Entity_Kind) return Boolean
+   is
+   begin
+      return T = V1  or else
+             T = V2  or else
+             T = V3  or else
+             T = V4  or else
+             T = V5  or else
+             T = V6  or else
+             T = V7  or else
+             T = V8  or else
+             T = V9  or else
+             T = V10 or else
+             T = V11;
+   end Ekind_In;
+
+   function Ekind_In
      (E  : Entity_Id;
       V1 : Entity_Kind;
       V2 : Entity_Kind) return Boolean
@@ -1225,6 +1279,42 @@ package body Atree is
       return Ekind_In (Ekind (E), V1, V2, V3, V4, V5, V6, V7, V8, V9);
    end Ekind_In;
 
+   function Ekind_In
+     (E   : Entity_Id;
+      V1  : Entity_Kind;
+      V2  : Entity_Kind;
+      V3  : Entity_Kind;
+      V4  : Entity_Kind;
+      V5  : Entity_Kind;
+      V6  : Entity_Kind;
+      V7  : Entity_Kind;
+      V8  : Entity_Kind;
+      V9  : Entity_Kind;
+      V10 : Entity_Kind) return Boolean
+   is
+   begin
+      return Ekind_In (Ekind (E), V1, V2, V3, V4, V5, V6, V7, V8, V9, V10);
+   end Ekind_In;
+
+   function Ekind_In
+     (E   : Entity_Id;
+      V1  : Entity_Kind;
+      V2  : Entity_Kind;
+      V3  : Entity_Kind;
+      V4  : Entity_Kind;
+      V5  : Entity_Kind;
+      V6  : Entity_Kind;
+      V7  : Entity_Kind;
+      V8  : Entity_Kind;
+      V9  : Entity_Kind;
+      V10 : Entity_Kind;
+      V11 : Entity_Kind) return Boolean
+   is
+   begin
+      return
+        Ekind_In (Ekind (E), V1, V2, V3, V4, V5, V6, V7, V8, V9, V10, V11);
+   end Ekind_In;
+
    ------------------------
    -- Set_Reporting_Proc --
    ------------------------

gcc/ada/atree.ads

@@ -803,6 +803,33 @@ package Atree is
       V9 : Entity_Kind) return Boolean;
 
    function Ekind_In
+     (E   : Entity_Id;
+      V1  : Entity_Kind;
+      V2  : Entity_Kind;
+      V3  : Entity_Kind;
+      V4  : Entity_Kind;
+      V5  : Entity_Kind;
+      V6  : Entity_Kind;
+      V7  : Entity_Kind;
+      V8  : Entity_Kind;
+      V9  : Entity_Kind;
+      V10 : Entity_Kind) return Boolean;
+
+   function Ekind_In
+     (E   : Entity_Id;
+      V1  : Entity_Kind;
+      V2  : Entity_Kind;
+      V3  : Entity_Kind;
+      V4  : Entity_Kind;
+      V5  : Entity_Kind;
+      V6  : Entity_Kind;
+      V7  : Entity_Kind;
+      V8  : Entity_Kind;
+      V9  : Entity_Kind;
+      V10 : Entity_Kind;
+      V11 : Entity_Kind) return Boolean;
+
+   function Ekind_In
      (T  : Entity_Kind;
       V1 : Entity_Kind;
       V2 : Entity_Kind) return Boolean;
@@ -870,6 +897,33 @@ package Atree is
       V8 : Entity_Kind;
       V9 : Entity_Kind) return Boolean;
 
+   function Ekind_In
+     (T   : Entity_Kind;
+      V1  : Entity_Kind;
+      V2  : Entity_Kind;
+      V3  : Entity_Kind;
+      V4  : Entity_Kind;
+      V5  : Entity_Kind;
+      V6  : Entity_Kind;
+      V7  : Entity_Kind;
+      V8  : Entity_Kind;
+      V9  : Entity_Kind;
+      V10 : Entity_Kind) return Boolean;
+
+   function Ekind_In
+     (T   : Entity_Kind;
+      V1  : Entity_Kind;
+      V2  : Entity_Kind;
+      V3  : Entity_Kind;
+      V4  : Entity_Kind;
+      V5  : Entity_Kind;
+      V6  : Entity_Kind;
+      V7  : Entity_Kind;
+      V8  : Entity_Kind;
+      V9  : Entity_Kind;
+      V10 : Entity_Kind;
+      V11 : Entity_Kind) return Boolean;
+
    pragma Inline (Ekind_In);
    --  Inline all above functions
 

gcc/ada/contracts.adb

@@ -578,6 +578,39 @@ package body Contracts is
       end if;
    end Analyze_Entry_Or_Subprogram_Contract;
 
+   ------------------------------------------
+   -- Analyze_Initial_Declaration_Contract --
+   ------------------------------------------
+
+   procedure Analyze_Initial_Declaration_Contract (Body_Decl : Node_Id) is
+      Spec_Id : constant Entity_Id := Unique_Defining_Entity (Body_Decl);
+
+   begin
+      --  Note that stubs are excluded because the compiler always analyzes the
+      --  proper body when a stub is encountered.
+
+      if Nkind (Body_Decl) = N_Entry_Body then
+         Analyze_Entry_Or_Subprogram_Contract (Spec_Id);
+
+      elsif Nkind (Body_Decl) = N_Package_Body then
+         Analyze_Package_Contract (Spec_Id);
+
+      elsif Nkind (Body_Decl) = N_Protected_Body then
+         Analyze_Protected_Contract (Spec_Id);
+
+      elsif Nkind (Body_Decl) = N_Subprogram_Body then
+         if Present (Corresponding_Spec (Body_Decl)) then
+            Analyze_Entry_Or_Subprogram_Contract (Spec_Id);
+         end if;
+
+      elsif Nkind (Body_Decl) = N_Task_Body then
+         Analyze_Task_Contract (Spec_Id);
+
+      else
+         raise Program_Error;
+      end if;
+   end Analyze_Initial_Declaration_Contract;
+
    -----------------------------
    -- Analyze_Object_Contract --
    -----------------------------

gcc/ada/contracts.ads

@@ -58,7 +58,7 @@ package Contracts is
    --    Volatile_Function
 
    procedure Analyze_Enclosing_Package_Body_Contract (Body_Decl : Node_Id);
-   --  Analyze the contract of the nearest package body (if any) enclosing
+   --  Analyze the contract of the nearest package body (if any) which encloses
    --  package or subprogram body Body_Decl.
 
    procedure Analyze_Entry_Or_Subprogram_Body_Contract (Body_Id : Entity_Id);
@@ -86,6 +86,10 @@ package Contracts is
    --    Precondition
    --    Test_Case
 
+   procedure Analyze_Initial_Declaration_Contract (Body_Decl : Node_Id);
+   --  Analyze the contract of the initial declaration of entry body, package
+   --  body, protected body, subprogram body or task body Body_Decl.
+
    procedure Analyze_Object_Contract (Obj_Id : Entity_Id);
    --  Analyze all delayed pragmas chained on the contract of object Obj_Id as
    --  if they appeared at the end of the declarative region. The pragmas to be

gcc/ada/einfo.adb

@@ -705,6 +705,7 @@ package body Einfo is
    function Access_Disp_Table (Id : E) return L is
    begin
       pragma Assert (Ekind_In (Id, E_Record_Type,
+                                   E_Record_Type_With_Private,
                                    E_Record_Subtype));
       return Elist16 (Implementation_Base_Type (Id));
    end Access_Disp_Table;

gcc/ada/par.adb

@@ -1577,11 +1577,14 @@ begin
                --  versions of these files. Another exception is System.RPC
                --  and its children. This allows a user to supply their own
                --  communication layer.
+               --  Similarly we do not generate an error in CodePeer mode
+               --  to allow users to analyze third party compier packages.
 
                if Comp_Unit_Node /= Error
                  and then Operating_Mode = Generate_Code
                  and then Current_Source_Unit = Main_Unit
                  and then not GNAT_Mode
+                 and then not CodePeer_Mode
                then
                   declare
                      Uname : constant String :=

gcc/ada/sem_ch6.adb

@@ -1378,6 +1378,15 @@ package body Sem_Ch6 is
             Analyze_Aspect_Specifications_On_Body_Or_Stub (N);
          end if;
 
+         --  A generic subprogram body "freezes" the contract of its initial
+         --  declaration. This analysis depends on attribute Corresponding_Spec
+         --  being set. Only bodies coming from source should cause this type
+         --  of "freezing".
+
+         if Comes_From_Source (N) then
+            Analyze_Initial_Declaration_Contract (N);
+         end if;
+
          Analyze_Declarations (Declarations (N));
          Check_Completion;
 
@@ -3756,6 +3765,14 @@ package body Sem_Ch6 is
          Analyze_Aspect_Specifications_On_Body_Or_Stub (N);
       end if;
 
+      --  A subprogram body "freezes" the contract of its initial declaration.
+      --  This analysis depends on attribute Corresponding_Spec being set. Only
+      --  bodies coming from source should cause this type of "freezing".
+
+      if Comes_From_Source (N) then
+         Analyze_Initial_Declaration_Contract (N);
+      end if;
+
       Analyze_Declarations (Declarations (N));
 
       --  Verify that the SPARK_Mode of the body agrees with that of its spec

gcc/ada/sem_ch7.adb

@@ -763,6 +763,14 @@ package body Sem_Ch7 is
          Declare_Inherited_Private_Subprograms (Spec_Id);
       end if;
 
+      --  A package body "freezes" the contract of its initial declaration.
+      --  This analysis depends on attribute Corresponding_Spec being set. Only
+      --  bodies coming from source shuld cause this type of "freezing".
+
+      if Comes_From_Source (N) then
+         Analyze_Initial_Declaration_Contract (N);
+      end if;
+
       if Present (Declarations (N)) then
          Analyze_Declarations (Declarations (N));
          Inspect_Deferred_Constant_Completion (Declarations (N));

gcc/ada/sem_ch9.adb

@@ -1354,6 +1354,11 @@ package body Sem_Ch9 is
            (Sloc (N), Entry_Name, P_Type, N, Decls);
       end if;
 
+      --  An entry body "freezes" the contract of its initial declaration. This
+      --  analysis depends on attribute Corresponding_Body being set.
+
+      Analyze_Initial_Declaration_Contract (N);
+
       if Present (Decls) then
          Analyze_Declarations (Decls);
          Inspect_Deferred_Constant_Completion (Decls);
@@ -1811,11 +1816,14 @@ package body Sem_Ch9 is
       Set_Corresponding_Body (Parent (Spec_Id), Body_Id);
       Set_Has_Completion (Spec_Id);
       Install_Declarations (Spec_Id);
-
       Expand_Protected_Body_Declarations (N, Spec_Id);
-
       Last_E := Last_Entity (Spec_Id);
 
+      --  A protected body "freezes" the contract of its initial declaration.
+      --  This analysis depends on attribute Corresponding_Spec being set.
+
+      Analyze_Initial_Declaration_Contract (N);
+
       Analyze_Declarations (Declarations (N));
 
       --  For visibility purposes, all entities in the body are private. Set
@@ -2818,9 +2826,9 @@ package body Sem_Ch9 is
 
    begin
       --  A task body "freezes" the contract of the nearest enclosing package
-      --  body. This ensures that any annotations referenced by the contract
-      --  of an entry or subprogram body declared within the current protected
-      --  body are available.
+      --  body. This ensures that annotations referenced by the contract of an
+      --  entry or subprogram body declared within the current protected body
+      --  are available.
 
       Analyze_Enclosing_Package_Body_Contract (N);
 
@@ -2884,6 +2892,11 @@ package body Sem_Ch9 is
       Install_Declarations (Spec_Id);
       Last_E := Last_Entity (Spec_Id);
 
+      --  A task body "freezes" the contract of its initial declaration. This
+      --  analysis depends on attribute Corresponding_Spec being set.
+
+      Analyze_Initial_Declaration_Contract (N);
+
       Analyze_Declarations (Decls);
       Inspect_Deferred_Constant_Completion (Decls);
 

gcc/ada/sem_prag.ads

@@ -300,9 +300,10 @@ package Sem_Prag is
    --  and Subp_Outputs (outputs). The inputs and outputs are gathered from:
    --    1) The formal parameters of the subprogram
    --    2) The generic formal parameters of the generic subprogram
-   --    3) The items of pragma [Refined_]Global
+   --    3) The current instance of a concurrent type
+   --    4) The items of pragma [Refined_]Global
    --         or
-   --    4) The items of pragma [Refined_]Depends if there is no pragma
+   --    5) The items of pragma [Refined_]Depends if there is no pragma
    --       [Refined_]Global present and flag Synthesize is set to True.
    --  If the subprogram has no inputs and/or outputs, then the returned list
    --  is No_Elist. Flag Global_Seen is set when the related subprogram has

gcc/ada/sem_util.adb

@@ -6347,7 +6347,10 @@ package body Sem_Util is
          --  Follow a possible chain of renamings to reach the root renamed
          --  object.
 
-         while Present (Id) and then Present (Renamed_Object (Id)) loop
+         while Present (Id)
+           and then Is_Object (Id)
+           and then Present (Renamed_Object (Id))
+         loop
             if Is_Entity_Name (Renamed_Object (Id)) then
                Id := Entity (Renamed_Object (Id));
             else
@@ -7113,7 +7116,7 @@ package body Sem_Util is
                Res_Index := Res_Index + 5;
 
             elsif Is_Task then
-               Res (Res_Index .. Res_Index + 8) := "task unit";
+               Res (Res_Index .. Res_Index + 8) := "task type";
                Res_Index := Res_Index + 9;
 
             else

gcc/ada/sem_util.ads

@@ -770,7 +770,7 @@ package Sem_Util is
    --  the Ekind of Id as follows:
    --    * Replace "subprogram" with
    --      - "entry" when Id is an entry [family]
-   --      - "task unit" when Id is a single task object, task type or task
+   --      - "task type" when Id is a single task object, task type or task
    --         body.
    --    * Replace "protected" with
    --      - "task" when Id is a single task object, task type or task body