[multiple changes]

2015-10-26  Claire Dross  <dross@adacore.com>

	* sem_aux.ads (Number_Components): Can return 0 when called on
	an empty record.

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

	* contracts.adb (Analyze_Subprogram_Body_Contract): Use
	Unique_Defining_Entity instead of Corresponding_Spec_Of.
	* einfo.adb SPARK_Pragma and SPARK_Aux_Pragma are now Node40 and
	Node41 respectively.
	(SPARK_Aux_Pragma): Update the assertion and node querry.
	(SPARK_Aux_Pragma_Inherited): Update the assertion and node query.
	(SPARK_Pragma): Update the assertion and node query.
	(SPARK_Pragma_Inherited): Update the assertion and node query.
	(Set_SPARK_Aux_Pragma): Update the assertion and node setting.
	(Set_SPARK_Aux_Pragma_Inherited): Update the assertion and node setting.
	(Set_SPARK_Pragma): Update the assertion and node setting.
	(Set_SPARK_Pragma_Inherited): Update the assertion and node setting.
	(Write_Field32_Name): Remove the output for SPARK_Pragma.
	(Write_Field33_Name): Remove the output for SPARK_Aux_Pragma.
	(Write_Field40_Name): Add output for SPARK_Pragma.
	(Write_Field41_Name): Add output for SPARK_Aux_Pragma.
	* einfo.ads Rewrite the documentation on attributes
	SPARK_Pragma, SPARK_Aux_Pragma, SPARK_Pragma_Inherited and
	SPARK_Aux_Pragma_Inherited. Update their uses in nodes.
	* exp_ch4.adb (Create_Anonymous_Master): Use
	Unique_Defining_Entity instead of Corresponding_Spec_Of.
	* exp_ch9.adb (Expand_Entry_Declaration): Mark the barrier
	function as such.
	(Expand_N_Task_Body): Mark the task body as such.
	(Expand_N_Task_Type_Declaration): Mark the task body as such.
	* exp_unst.adb (Visit_Node): Use Unique_Defining_Entity instead
	of Corresponding_Spec_Of.
	* sem_attr.adb (Analyze_Attribute_Old_Result): Use
	Unique_Defining_Entity instead of Corresponding_Spec_Of.
	* sem_ch6.adb (Analyze_Subprogram_Body_Helper): Entry barrier
	functions do not inherit the SPARK_Mode from the context.
	(Build_Subprogram_Declaration): The matching spec is now marked
	as a source construct to mimic the original stand alone body.
	* sem_ch7.adb (Analyze_Package_Body_Helper): Code cleanup.
	* sem_ch9.adb Add with and use clauses for Contracts.
	(Analyze_Entry_Body): An entry body freezes the contract of
	the nearest enclosing package body. The entry body now inherits
	the SPARK_Mode from the context.
	(Analyze_Entry_Declaration): A protected entry declaration now inherits
	the SPARK_Mode from the context.
	(Analyze_Protected_Body): A protected body freezes
	the contract of the nearest enclosing package body. Set the
	Etype of a protected body as this is neede for proper aspect
	analysis. Protected bodies can now carry meaningful aspects and
	those are now analyzed.
	(Analyze_Protected_Type_Declaration): A protected type now inherits the
	SPARK_Mode from the context.
	(Analyze_Task_Body): A task body freezes the contract of the
	nearest enclosing package body. Set the Etype of a task body
	as this is needed for proper aspect analysis. A task body
	now inherits the SPARK_Mode from the context.  Task bodies
	can now carry meaningful aspects and those are now analyzed.
	(Analyze_Task_Type_Declaration): A task type declaration now
	inherits the SPARK_Mode of from the context.
	* sem_ch10.adb (Analyze_Protected_Body_Stub): Protected body
	stubs can now carry meaningful aspects.
	(Analyze_Task_Body_Stub): Task body stubs can now carry meaningful
	aspects.
	* sem_ch13.adb (Analyze_Aspect_Specifications): Aspects SPARK_Mode
	Warnings now use routine Insert_Pragma as means of insertion into
	the tree.
	(Insert_After_SPARK_Mode): Clean up documentation.
	(Insert_Pragma): Clean up documentation. The routine is now
	capable of operating on synchronized units.
	* sem_prag.adb (Add_Entity_To_Name_Buffer): New routine.
	(Analyze_Contract_Cases_In_Decl_Part): Use
	Unique_Defining_Entity instead of Corresponding_Spec_Of.
	(Analyze_Depends_Global): Use Unique_Defining_Entity instead
	of Corresponding_Spec_Of.
	(Analyze_Depends_In_Decl_Part): Use Unique_Defining_Entity instead of
	Corresponding_Spec_Of.
	(Analyze_Global_In_Decl_Part): Use Unique_Defining_Entity instead of
	Corresponding_Spec_Of.
	(Analyze_Pragma): Use Unique_Defining_Entity instead of
	Corresponding_Spec_Of.
	Update the detection of an illegal pragma Ghost when it applies
	to a task or protected unit. Reimplement the handling of
	pragma SPARK_Mode.
	(Analyze_Pre_Post_Condition_In_Decl_Part): Use Unique_Defining_Entity
	instead of Corresponding_Spec_Of.
	(Analyze_Test_Case_In_Decl_Part): Use Unique_Defining_Entity instead of
	Corresponding_Spec_Of.
	(Check_Library_Level_Entity): Update the comment on usage.
	Reimplemented to offer a more specialized errror context.
	(Check_Pragma_Conformance): Update profile and comment on usage.
	Handle error message output on single protected or task units.
	(Collect_Subprogram_Inputs_Outputs): Use Unique_Defining_Entity
	instead of Corresponding_Spec_Of.
	(Process_Body): New routine.
	(Process_Overloadable): New routine.
	(Process_Private_Part): New routine.
	(Process_Statement_Part): New routine.
	(Process_Visible_Part): New routine.
	(Set_SPARK_Context): New routine.
	(Set_SPARK_Flags): Removed.
	* sem_util.adb (Corresponding_Spec_Of): Removed.
	(Unique_Entity): Reimplemented to handle many more cases.
	* sem_util.ads (Corresponding_Spec_Of): Removed.
	(Unique_Defining_Entity): Update the comment on usage.
	* sinfo.ads (Is_Entry_Barrier_Function): Update the assertion.
	(Is_Task_Body_Procedure): New routine.
	(Set_Is_Entry_Barrier_Function): Update the assertion.
	(Set_Is_Task_Body_Procedure): New routine.
	* sinfo.adb Update the documentation of attribute
	Is_Entry_Barrier_Function along with use in nodes. Add new
	attribute Is_Task_Body_Procedure along with use in nodes.
	(Is_Task_Body_Procedure): New routine along with pragma Inline.
	(Set_Is_Task_Body_Procedure): New routine along with pragma Inline.

From-SVN: r229328

1 files changed, 110 insertions, 75 deletions

diff --git a/gcc/ada/sem_ch9.adb b/gcc/ada/sem_ch9.adb
index 728d17d..3494eb5 100644
--- a/gcc/ada/sem_ch9.adb
+++ b/gcc/ada/sem_ch9.adb
@@ -23,42 +23,43 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
-with Aspects;  use Aspects;
-with Atree;    use Atree;
-with Checks;   use Checks;
-with Debug;    use Debug;
-with Einfo;    use Einfo;
-with Errout;   use Errout;
-with Exp_Ch9;  use Exp_Ch9;
-with Elists;   use Elists;
-with Freeze;   use Freeze;
-with Layout;   use Layout;
-with Lib.Xref; use Lib.Xref;
-with Namet;    use Namet;
-with Nlists;   use Nlists;
-with Nmake;    use Nmake;
-with Opt;      use Opt;
-with Restrict; use Restrict;
-with Rident;   use Rident;
-with Rtsfind;  use Rtsfind;
-with Sem;      use Sem;
-with Sem_Aux;  use Sem_Aux;
-with Sem_Ch3;  use Sem_Ch3;
-with Sem_Ch5;  use Sem_Ch5;
-with Sem_Ch6;  use Sem_Ch6;
-with Sem_Ch8;  use Sem_Ch8;
-with Sem_Ch13; use Sem_Ch13;
-with Sem_Eval; use Sem_Eval;
-with Sem_Res;  use Sem_Res;
-with Sem_Type; use Sem_Type;
-with Sem_Util; use Sem_Util;
-with Sem_Warn; use Sem_Warn;
-with Snames;   use Snames;
-with Stand;    use Stand;
-with Sinfo;    use Sinfo;
+with Aspects;   use Aspects;
+with Atree;     use Atree;
+with Checks;    use Checks;
+with Contracts; use Contracts;
+with Debug;     use Debug;
+with Einfo;     use Einfo;
+with Errout;    use Errout;
+with Exp_Ch9;   use Exp_Ch9;
+with Elists;    use Elists;
+with Freeze;    use Freeze;
+with Layout;    use Layout;
+with Lib.Xref;  use Lib.Xref;
+with Namet;     use Namet;
+with Nlists;    use Nlists;
+with Nmake;     use Nmake;
+with Opt;       use Opt;
+with Restrict;  use Restrict;
+with Rident;    use Rident;
+with Rtsfind;   use Rtsfind;
+with Sem;       use Sem;
+with Sem_Aux;   use Sem_Aux;
+with Sem_Ch3;   use Sem_Ch3;
+with Sem_Ch5;   use Sem_Ch5;
+with Sem_Ch6;   use Sem_Ch6;
+with Sem_Ch8;   use Sem_Ch8;
+with Sem_Ch13;  use Sem_Ch13;
+with Sem_Eval;  use Sem_Eval;
+with Sem_Res;   use Sem_Res;
+with Sem_Type;  use Sem_Type;
+with Sem_Util;  use Sem_Util;
+with Sem_Warn;  use Sem_Warn;
+with Snames;    use Snames;
+with Stand;     use Stand;
+with Sinfo;     use Sinfo;
 with Style;
-with Tbuild;   use Tbuild;
-with Uintp;    use Uintp;
+with Tbuild;    use Tbuild;
+with Uintp;     use Uintp;
 
 package body Sem_Ch9 is
 
@@ -1190,6 +1191,13 @@ package body Sem_Ch9 is
       Entry_Name : Entity_Id;
 
    begin
+      --  An entry 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.
+
+      Analyze_Enclosing_Package_Body_Contract (N);
+
       Tasking_Used := True;
 
       --  Entry_Name is initialized to Any_Id. It should get reset to the
@@ -1209,6 +1217,12 @@ package body Sem_Ch9 is
       Set_Etype          (Id, Standard_Void_Type);
       Set_Accept_Address (Id, New_Elmt_List);
 
+      --  Set the SPARK_Mode from the current context (may be overwritten later
+      --  with an explicit pragma).
+
+      Set_SPARK_Pragma           (Id, SPARK_Mode_Pragma);
+      Set_SPARK_Pragma_Inherited (Id);
+
       E := First_Entity (P_Type);
       while Present (E) loop
          if Chars (E) = Chars (Id)
@@ -1217,7 +1231,7 @@ package body Sem_Ch9 is
          then
             Entry_Name := E;
             Set_Convention (Id, Convention (E));
-            Set_Corresponding_Body (Parent (Entry_Name), Id);
+            Set_Corresponding_Body (Parent (E), Id);
             Check_Fully_Conformant (Id, E, N);
 
             if Ekind (Id) = E_Entry_Family then
@@ -1601,6 +1615,15 @@ package body Sem_Ch9 is
       Set_Convention     (Def_Id, Convention_Entry);
       Set_Accept_Address (Def_Id, New_Elmt_List);
 
+      --  Set the SPARK_Mode from the current context (may be overwritten later
+      --  with an explicit pragma). Task entries are excluded because they are
+      --  not completed by entry bodies.
+
+      if Ekind (Current_Scope) = E_Protected_Type then
+         Set_SPARK_Pragma           (Def_Id, SPARK_Mode_Pragma);
+         Set_SPARK_Pragma_Inherited (Def_Id);
+      end if;
+
       --  Process formals
 
       if Present (Formals) then
@@ -1730,29 +1753,19 @@ package body Sem_Ch9 is
    --  Start of processing for Analyze_Protected_Body
 
    begin
+      --  A protected 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.
+
+      Analyze_Enclosing_Package_Body_Contract (N);
+
       Tasking_Used := True;
       Set_Ekind (Body_Id, E_Protected_Body);
+      Set_Etype (Body_Id, Standard_Void_Type);
       Spec_Id := Find_Concurrent_Spec (Body_Id);
 
-      --  Protected bodies are currently removed by the expander. Since there
-      --  are no language-defined aspects that apply to a protected body, it is
-      --  not worth changing the whole expansion to accomodate implementation-
-      --  defined aspects. Plus we cannot possibly known the semantics of such
-      --  future implementation-defined aspects in order to plan ahead.
-
-      if Has_Aspects (N) then
-         Error_Msg_N
-           ("aspects on protected bodies are not allowed",
-            First (Aspect_Specifications (N)));
-
-         --  Remove illegal aspects to prevent cascaded errors later on
-
-         Remove_Aspects (N);
-      end if;
-
-      if Present (Spec_Id)
-        and then Ekind (Spec_Id) = E_Protected_Type
-      then
+      if Present (Spec_Id) and then Ekind (Spec_Id) = E_Protected_Type then
          null;
 
       elsif Present (Spec_Id)
@@ -1776,6 +1789,10 @@ package body Sem_Ch9 is
          Spec_Id := Etype (Spec_Id);
       end if;
 
+      if Has_Aspects (N) then
+         Analyze_Aspect_Specifications (N, Body_Id);
+      end if;
+
       Push_Scope (Spec_Id);
       Set_Corresponding_Spec (N, Spec_Id);
       Set_Corresponding_Body (Parent (Spec_Id), Body_Id);
@@ -1967,6 +1984,15 @@ package body Sem_Ch9 is
       Set_Etype              (T, T);
       Set_Has_Delayed_Freeze (T, True);
       Set_Stored_Constraint  (T, No_Elist);
+
+      --  Set the SPARK_Mode from the current context (may be overwritten later
+      --  with an explicit pragma).
+
+      Set_SPARK_Pragma               (T, SPARK_Mode_Pragma);
+      Set_SPARK_Aux_Pragma           (T, SPARK_Mode_Pragma);
+      Set_SPARK_Pragma_Inherited     (T);
+      Set_SPARK_Aux_Pragma_Inherited (T);
+
       Push_Scope (T);
 
       if Ada_Version >= Ada_2005 then
@@ -2719,33 +2745,23 @@ package body Sem_Ch9 is
       --  a single task, since Spec_Id is set to the task type).
 
    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.
+
+      Analyze_Enclosing_Package_Body_Contract (N);
+
       Tasking_Used := True;
-      Set_Ekind (Body_Id, E_Task_Body);
       Set_Scope (Body_Id, Current_Scope);
+      Set_Ekind (Body_Id, E_Task_Body);
+      Set_Etype (Body_Id, Standard_Void_Type);
       Spec_Id := Find_Concurrent_Spec (Body_Id);
 
-      --  Task bodies are transformed into a subprogram spec and body pair by
-      --  the expander. Since there are no language-defined aspects that apply
-      --  to a task body, it is not worth changing the whole expansion to
-      --  accomodate implementation-defined aspects. Plus we cannot possibly
-      --  know semantics of such aspects in order to plan ahead.
-
-      if Has_Aspects (N) then
-         Error_Msg_N
-           ("aspects on task bodies are not allowed",
-            First (Aspect_Specifications (N)));
-
-         --  Remove illegal aspects to prevent cascaded errors later on
-
-         Remove_Aspects (N);
-      end if;
-
       --  The spec is either a task type declaration, or a single task
       --  declaration for which we have created an anonymous type.
 
-      if Present (Spec_Id)
-        and then Ekind (Spec_Id) = E_Task_Type
-      then
+      if Present (Spec_Id) and then Ekind (Spec_Id) = E_Task_Type then
          null;
 
       elsif Present (Spec_Id)
@@ -2779,6 +2795,16 @@ package body Sem_Ch9 is
          Spec_Id := Etype (Spec_Id);
       end if;
 
+      --  Set the SPARK_Mode from the current context (may be overwritten later
+      --  with an explicit pragma).
+
+      Set_SPARK_Pragma           (Body_Id, SPARK_Mode_Pragma);
+      Set_SPARK_Pragma_Inherited (Body_Id);
+
+      if Has_Aspects (N) then
+         Analyze_Aspect_Specifications (N, Body_Id);
+      end if;
+
       Push_Scope (Spec_Id);
       Set_Corresponding_Spec (N, Spec_Id);
       Set_Corresponding_Body (Parent (Spec_Id), Body_Id);
@@ -2939,6 +2965,15 @@ package body Sem_Ch9 is
       Set_Etype              (T, T);
       Set_Has_Delayed_Freeze (T, True);
       Set_Stored_Constraint  (T, No_Elist);
+
+      --  Set the SPARK_Mode from the current context (may be overwritten later
+      --  with an explicit pragma).
+
+      Set_SPARK_Pragma               (T, SPARK_Mode_Pragma);
+      Set_SPARK_Aux_Pragma           (T, SPARK_Mode_Pragma);
+      Set_SPARK_Pragma_Inherited     (T);
+      Set_SPARK_Aux_Pragma_Inherited (T);
+
       Push_Scope (T);
 
       if Ada_Version >= Ada_2005 then