[multiple changes]

2017-01-06  Justin Squirek  <squirek@adacore.com>

	* sem_attr.adb (Analyze_Attribute): Modify semantic checks for
	Finalization_Size to allow a prefix of any non-class-wide type.
	* sem_attr.ads Modify comment for Finalization_Size to include
	definite type use case.

2017-01-06  Ed Schonberg  <schonberg@adacore.com>

	* einfo.ads, einfo.adb (Is_Entry_Wrapper): New flag, defined
	on procedures that are wrappers created for entries that have
	preconditions.
	* sem_ch6.adb (Analyze_Subrogram_Body_Helper): If the subprogram
	body is an entry_wrapper, compile it in the context of the
	synchronized type, because a precondition may refer to funtions
	of the type.
	* exp_ch9.adb (Build_Contract_Wrapper): Set Is_Entry_Wrapper on
	body entity.
	* exp_ch6.adb (Expand_Protected_Subprogram_Call): if the call is
	within an Entry_Wrapper this is an external call whose target
	is the synchronized object that is the actual in the call to
	the wrapper.

From-SVN: r244138

gcc/ada/ChangeLog

@@ -1,3 +1,26 @@
+2017-01-06  Justin Squirek  <squirek@adacore.com>
+
+	* sem_attr.adb (Analyze_Attribute): Modify semantic checks for
+	Finalization_Size to allow a prefix of any non-class-wide type.
+	* sem_attr.ads Modify comment for Finalization_Size to include
+	definite type use case.
+
+2017-01-06  Ed Schonberg  <schonberg@adacore.com>
+
+	* einfo.ads, einfo.adb (Is_Entry_Wrapper): New flag, defined
+	on procedures that are wrappers created for entries that have
+	preconditions.
+	* sem_ch6.adb (Analyze_Subrogram_Body_Helper): If the subprogram
+	body is an entry_wrapper, compile it in the context of the
+	synchronized type, because a precondition may refer to funtions
+	of the type.
+	* exp_ch9.adb (Build_Contract_Wrapper): Set Is_Entry_Wrapper on
+	body entity.
+	* exp_ch6.adb (Expand_Protected_Subprogram_Call): if the call is
+	within an Entry_Wrapper this is an external call whose target
+	is the synchronized object that is the actual in the call to
+	the wrapper.
+
 2017-01-06  Yannick Moy  <moy@adacore.com>
 
 	* sem_attr.adb (Analyze_Attribute/Attribute_Loop_Entry): Analyze node

gcc/ada/einfo.adb

@@ -613,8 +613,8 @@ package body Einfo is
    --    Has_Pragma_Unused               Flag294
    --    Is_Ignored_Transient            Flag295
    --    Has_Partial_Visible_Refinement  Flag296
+   --    Is_Entry_Wrapper                Flag297
 
-   --    (unused)                        Flag297
    --    (unused)                        Flag298
    --    (unused)                        Flag299
    --    (unused)                        Flag300
@@ -2197,6 +2197,11 @@ package body Einfo is
       return Flag52 (Id);
    end Is_Entry_Formal;
 
+   function Is_Entry_Wrapper (Id : E) return B is
+   begin
+      return Flag297 (Id);
+   end Is_Entry_Wrapper;
+
    function Is_Exception_Handler (Id : E) return B is
    begin
       pragma Assert (Ekind (Id) = E_Block);
@@ -5287,6 +5292,11 @@ package body Einfo is
       Set_Flag52 (Id, V);
    end Set_Is_Entry_Formal;
 
+   procedure Set_Is_Entry_Wrapper (Id : E; V : B := True) is
+   begin
+      Set_Flag297 (Id, V);
+   end Set_Is_Entry_Wrapper;
+
    procedure Set_Is_Exception_Handler (Id : E; V : B := True) is
    begin
       pragma Assert (Ekind (Id) = E_Block);

gcc/ada/einfo.ads

@@ -2483,6 +2483,10 @@ package Einfo is
 --       be in, in-out or out parameters). This flag is used to speed up the
 --       test for the need to replace references in Exp_Ch2.
 
+--    Is_Entry_Wrapper (Flag297)
+--       Defined on wrappers that are created for entries that have pre-
+--       condition aspects.
+
 --    Is_Enumeration_Type (synthesized)
 --       Defined in all entities, true for enumeration types and subtypes
 
@@ -5893,6 +5897,7 @@ package Einfo is
    --    Sec_Stack_Needed_For_Return         (Flag167)
    --    Has_Expanded_Contract               (Flag240)
    --    SPARK_Pragma_Inherited              (Flag265)  (protected kind)
+   --    Is_Entry_Wrapper                    (Flag297)
    --    Address_Clause                      (synth)
    --    Entry_Index_Type                    (synth)
    --    First_Formal                        (synth)
@@ -7102,6 +7107,7 @@ package Einfo is
    function Is_Dispatching_Operation            (Id : E) return B;
    function Is_Eliminated                       (Id : E) return B;
    function Is_Entry_Formal                     (Id : E) return B;
+   function Is_Entry_Wrapper                    (Id : E) return B;
    function Is_Exception_Handler                (Id : E) return B;
    function Is_Exported                         (Id : E) return B;
    function Is_Finalized_Transient              (Id : E) return B;
@@ -7781,6 +7787,7 @@ package Einfo is
    procedure Set_Is_Dispatching_Operation        (Id : E; V : B := True);
    procedure Set_Is_Eliminated                   (Id : E; V : B := True);
    procedure Set_Is_Entry_Formal                 (Id : E; V : B := True);
+   procedure Set_Is_Entry_Wrapper                (Id : E; V : B := True);
    procedure Set_Is_Exception_Handler            (Id : E; V : B := True);
    procedure Set_Is_Exported                     (Id : E; V : B := True);
    procedure Set_Is_Finalized_Transient          (Id : E; V : B := True);
@@ -8591,6 +8598,7 @@ package Einfo is
    pragma Inline (Is_Eliminated);
    pragma Inline (Is_Entry);
    pragma Inline (Is_Entry_Formal);
+   pragma Inline (Is_Entry_Wrapper);
    pragma Inline (Is_Enumeration_Type);
    pragma Inline (Is_Exception_Handler);
    pragma Inline (Is_Exported);
@@ -9091,6 +9099,7 @@ package Einfo is
    pragma Inline (Set_Is_Dispatching_Operation);
    pragma Inline (Set_Is_Eliminated);
    pragma Inline (Set_Is_Entry_Formal);
+   pragma Inline (Set_Is_Entry_Wrapper);
    pragma Inline (Set_Is_Exception_Handler);
    pragma Inline (Set_Is_Exported);
    pragma Inline (Set_Is_Finalized_Transient);

gcc/ada/exp_ch6.adb

@@ -6014,6 +6014,19 @@ package body Exp_Ch6 is
          elsif Nkind (Name (N)) = N_Indexed_Component then
             Rec := Prefix (Prefix (Name (N)));
 
+         --  If this is a call within an entry wrapper, it appears within a
+         --  precondition that calls another primitive of the synchronized
+         --  type. The target object of the call is the first actual on the
+         --  wrapper. Note that this is an external call, because the wrapper
+         --  is called outside of the synchronized object. This means that
+         --  an entry call to an entry with preconditions involves two
+         --  synchronized operations.
+
+         elsif Ekind (Current_Scope) = E_Procedure
+           and then Is_Entry_Wrapper (Current_Scope)
+         then
+            Rec := New_Occurrence_Of (First_Entity (Current_Scope), Sloc (N));
+
          else
             --  If the context is the initialization procedure for a protected
             --  type, the call is legal because the called entity must be a

gcc/ada/exp_ch9.adb

@@ -1495,6 +1495,7 @@ package body Exp_Ch9 is
       Wrapper_Id :=
         Make_Defining_Identifier (Loc, New_External_Name (Chars (E), 'E'));
       Set_Contract_Wrapper (E, Wrapper_Id);
+      Set_Is_Entry_Wrapper (Wrapper_Id);
 
       --  The wrapper body is analyzed when the enclosing type is frozen
 

gcc/ada/sem_attr.adb

@@ -3839,8 +3839,27 @@ package body Sem_Attr is
 
       when Attribute_Finalization_Size =>
          Check_E0;
+
+         if Is_Object_Reference (P) then
             Analyze_And_Resolve (P);
             Check_Object_Reference (P);
+
+         --  Redundant type verification for accurate error output
+
+         elsif not Is_Entity_Name (P)
+           or else not Is_Type (Entity (P))
+         then
+            Error_Attr_P ("prefix of % attribute must be a definite type or" &
+                          " an object");
+         else
+            Check_Type;
+            Check_Not_Incomplete_Type;
+            if Is_Class_Wide_Type (Etype (P)) then
+               Error_Attr_P ("prefix of % attribute cannot be applied to " &
+                             "a class-wide type");
+            end if;
+         end if;
+
          Set_Etype (N, Universal_Integer);
 
       -----------

gcc/ada/sem_attr.ads

@@ -247,10 +247,10 @@ package Sem_Attr is
       -----------------------
 
       Attribute_Finalization_Size => True,
-      --  For every object, Finalization_Size returns the size of the hidden
+      --  For every object or non-class-wide-type, Finalization_Size returns
-      --  header used for finalization purposes as if the object was allocated
+      --  the size of the hidden header used for finalization purposes as if
-      --  on the heap. The size of the header does take into account any extra
+      --  the object or type was allocated on the heap. The size of the header
-      --  padding due to alignment issues.
+      --  does take into account any extra padding due to alignment issues.
 
       -----------------
       -- Fixed_Value --

gcc/ada/sem_ch6.adb

@@ -62,6 +62,7 @@ with Sem_Ch3;   use Sem_Ch3;
 with Sem_Ch4;   use Sem_Ch4;
 with Sem_Ch5;   use Sem_Ch5;
 with Sem_Ch8;   use Sem_Ch8;
+with Sem_Ch9;   use Sem_Ch9;
 with Sem_Ch10;  use Sem_Ch10;
 with Sem_Ch12;  use Sem_Ch12;
 with Sem_Ch13;  use Sem_Ch13;
@@ -3640,6 +3641,21 @@ package body Sem_Ch6 is
             Generate_Definition (Body_Id);
             Generate_Reference
               (Body_Id, Body_Id, 'b', Set_Ref => False, Force => True);
+
+            --  If the body is an entry wrapper created for an entry with
+            --  preconditions, it must compiled in the context of the
+            --  enclosing synchronized object, because it may mention other
+            --  operations of the type.
+
+            if Is_Entry_Wrapper (Body_Id) then
+               declare
+                  Prot : constant Entity_Id := Etype (First_Entity (Body_Id));
+               begin
+                  Push_Scope (Prot);
+                  Install_Declarations (Prot);
+               end;
+            end if;
+
             Install_Formals (Body_Id);
 
             Push_Scope (Body_Id);
@@ -4000,6 +4016,14 @@ package body Sem_Ch6 is
 
       Process_End_Label (HSS, 't', Current_Scope);
       End_Scope;
+
+      --  If we are compiling an entry wrapper, remove the enclosing
+      --  syncrhonized object from the stack.
+
+      if Is_Entry_Wrapper (Body_Id) then
+         End_Scope;
+      end if;
+
       Check_Subprogram_Order (N);
       Set_Analyzed (Body_Id);