[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:
parent
50145b9389
commit
5e127570e2
|
@ -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
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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);
|
||||
|
||||
-----------
|
||||
|
|
|
@ -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 --
|
||||
|
|
|
@ -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);
|
||||
|
||||
|
|
Loading…
Reference in New Issue