[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
This commit is contained in:
Arnaud Charlet 2017-01-06 12:22:32 +01:00
parent 50145b9389
commit 5e127570e2
8 changed files with 106 additions and 7 deletions

View File

@ -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

View File

@ -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);

View File

@ -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);

View File

@ -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

View File

@ -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

View File

@ -3839,8 +3839,27 @@ package body Sem_Attr is
when Attribute_Finalization_Size =>
Check_E0;
Analyze_And_Resolve (P);
Check_Object_Reference (P);
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);
-----------

View File

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

View File

@ -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);