+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
-- 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
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);
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);
-- 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
-- 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)
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;
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);
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);
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);
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
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
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);
-----------
-----------------------
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 --
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;
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);
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);
projects / gcc.git / commitdiff