* einfo.adb (Write_Field28_Name): Update the choices for
Extra_Formals.
* einfo.ads: Update the use of Extra_Formals in various entities.
* exp_ch6.adb (Add_Task_Actuals_To_Build_In_Place_Call): Code
reformatting. Handle the case where the function call returns
an incomplete type coming from a limited with context. Generate
a reference to the _master when the master id is associated
with an access type.
(Is_Build_In_Place_Function_Call): Code
reformatting. The Alfa mode case must appear first since otherwise
we will carry out the function name retrieval regardless of the
compilation mode.
(Make_Build_In_Place_Call_In_Allocator): Code
reformatting. Handle the case where the function call returns
an incomplete type coming from a limited with context. Remove
the reference creation when adding the task-related actuals,
this is now done in Add_Task_Actuals_To_Build_In_Place_Call.
* exp_ch7.adb (Make_Set_Finalize_Address_Call): Remove local
variable Call. Remove the useless wrapping of Set_Finalize_Address
when the finalization master is a build-in-place extra formal. The
whole mechanism of controlled allocation in a build-in-place
context is already protected by an if statement.
* sem_aux.adb (Is_Immutably_Limited_Type): Handle the case
where the type might be related to a function which returns an
incomplete type coming from a limited with.
* sem_ch6.adb (Create_Extra_Formals): Comment
reformatting. Handle the case where the function returns an
incomplete type coming from a limited with context.
2011-09-05 Johannes Kanig <kanig@adacore.com>
* lib-xref-alfa.adb (Is_Alfa_Reference): Improve test for constant
objects and rewrite case statement as /if/elsif/endif.
2011-09-05 Thomas Quinot <quinot@adacore.com>
* sem_ch3.adb, sem_ch4.adb: Minor reformatting.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@178537
138bc75d-0d04-0410-961f-
82ee72b054a4
procedure Write_Field28_Name (Id : Entity_Id) is
begin
case Ekind (Id) is
- when E_Procedure |
+ when E_Entry |
+ E_Entry_Family |
E_Function |
- E_Entry =>
+ E_Procedure |
+ E_Subprogram_Body |
+ E_Subprogram_Type =>
Write_Str ("Extra_Formals");
when E_Record_Type =>
-- Protection_Object (Node23) (protected kind)
-- Contract (Node24) (for entry only)
-- PPC_Wrapper (Node25)
+ -- Extra_Formals (Node28)
-- Default_Expressions_Processed (Flag108)
-- Entry_Accepted (Flag152)
-- Is_AST_Entry (Flag132) (for entry only)
-- Corresponding_Protected_Entry (Node18)
-- Last_Entity (Node20)
-- Scope_Depth_Value (Uint22)
+ -- Extra_Formals (Node28)
-- Scope_Depth (synth)
-- E_Subprogram_Type
-- Directly_Designated_Type (Node20)
+ -- Extra_Formals (Node28)
-- First_Formal (synth)
-- First_Formal_With_Extras (synth)
-- Last_Formal (synth)
begin
-- No such extra parameters are needed if there are no tasks
- if not Has_Task (Etype (Function_Id)) then
+ if not Has_Task (Available_View (Etype (Function_Id))) then
return;
end if;
if Restriction_Active (No_Task_Hierarchy) then
Actual := New_Occurrence_Of (RTE (RE_Library_Task_Level), Loc);
+
+ -- In the case where we use the master associated with an access type,
+ -- the actual is an entity and requires an explicit reference.
+
+ elsif Nkind (Actual) = N_Defining_Identifier then
+ Actual := New_Reference_To (Actual, Loc);
end if;
-- The master
-- Build the parameter association for the new actual and add it to
-- the end of the function's actuals.
- Add_Extra_Actual_To_Call
- (Function_Call, Master_Formal, Actual);
+ Add_Extra_Actual_To_Call (Function_Call, Master_Formal, Actual);
end;
-- The activation chain
begin
-- Locate implicit activation chain parameter in the called function
- Activation_Chain_Formal := Build_In_Place_Formal
- (Function_Id, BIP_Activation_Chain);
+ Activation_Chain_Formal :=
+ Build_In_Place_Formal (Function_Id, BIP_Activation_Chain);
-- Create the actual which is a pointer to the current activation
-- chain
-- Step past qualification or unchecked conversion (the latter can occur
-- in cases of calls to 'Input).
- if Nkind_In
- (Exp_Node, N_Qualified_Expression, N_Unchecked_Type_Conversion)
+ if Nkind_In (Exp_Node, N_Qualified_Expression,
+ N_Unchecked_Type_Conversion)
then
Exp_Node := Expression (N);
end if;
return False;
else
- if Is_Entity_Name (Name (Exp_Node)) then
+ -- In Alfa mode, build-in-place calls are not expanded, so that we
+ -- may end up with a call that is neither resolved to an entity, nor
+ -- an indirect call.
+
+ if Alfa_Mode then
+ return False;
+
+ elsif Is_Entity_Name (Name (Exp_Node)) then
Function_Id := Entity (Name (Exp_Node));
+ -- In the case of an explicitly dereferenced call, use the subprogram
+ -- type generated for the dereference.
+
elsif Nkind (Name (Exp_Node)) = N_Explicit_Dereference then
Function_Id := Etype (Name (Exp_Node));
- -- In Alfa mode, protected subprogram calls are not expanded, so that
- -- we may end up with a call that is neither resolved to an entity,
- -- nor an indirect call.
-
- elsif Alfa_Mode then
- return False;
-
else
raise Program_Error;
end if;
(Allocator : Node_Id;
Function_Call : Node_Id)
is
+ Acc_Type : constant Entity_Id := Etype (Allocator);
Loc : Source_Ptr;
Func_Call : Node_Id := Function_Call;
Function_Id : Entity_Id;
Result_Subt : Entity_Id;
- Acc_Type : constant Entity_Id := Etype (Allocator);
New_Allocator : Node_Id;
Return_Obj_Access : Entity_Id;
raise Program_Error;
end if;
- Result_Subt := Etype (Function_Id);
+ Result_Subt := Available_View (Etype (Function_Id));
-- Check whether return type includes tasks. This may not have been done
-- previously, if the type was a limited view.
Add_Finalization_Master_Actual_To_Build_In_Place_Call
(Func_Call, Function_Id, Acc_Type);
- -- If access type has a master entity, pass a reference to it
-
- if Present (Master_Id (Acc_Type)) then
- Add_Task_Actuals_To_Build_In_Place_Call
- (Func_Call, Function_Id,
- Master_Actual =>
- New_Occurrence_Of (Master_Id (Acc_Type), Loc));
- else
- Add_Task_Actuals_To_Build_In_Place_Call
- (Func_Call, Function_Id, Empty);
- end if;
+ Add_Task_Actuals_To_Build_In_Place_Call
+ (Func_Call, Function_Id, Master_Actual => Master_Id (Acc_Type));
-- The caller does not provide the return object in this case, so we
-- have to pass null for the object access actual.
Desig_Typ : constant Entity_Id :=
Available_View (Designated_Type (Ptr_Typ));
Fin_Mas_Id : constant Entity_Id := Finalization_Master (Ptr_Typ);
- Call : Node_Id;
Fin_Mas_Ref : Node_Id;
Utyp : Entity_Id;
-- Generate:
-- Set_Finalize_Address (<Ptr_Typ>FM, <Utyp>FD'Unrestricted_Access);
- Call :=
+ return
Make_Procedure_Call_Statement (Loc,
Name =>
New_Reference_To (RTE (RE_Set_Finalize_Address), Loc),
Prefix =>
New_Reference_To (TSS (Utyp, TSS_Finalize_Address), Loc),
Attribute_Name => Name_Unrestricted_Access)));
-
- -- In the case of build-in-place functions, protect the call to ensure
- -- we have a master at run time. Generate:
-
- -- if <Ptr_Typ>FM /= null then
- -- <Call>;
- -- end if;
-
- if Is_Access_Type (Etype (Fin_Mas_Id)) then
- Call :=
- Make_If_Statement (Loc,
- Condition =>
- Make_Op_Ne (Loc,
- Left_Opnd => New_Reference_To (Fin_Mas_Id, Loc),
- Right_Opnd => Make_Null (Loc)),
- Then_Statements => New_List (Call));
- end if;
-
- return Call;
end Make_Set_Finalize_Address_Call;
--------------------------
Typ : Character) return Boolean
is
begin
- -- The only references of interest on callable entities are calls.
- -- On non-callable entities, the only references of interest are
- -- reads and writes.
- case Ekind (E) is
- when Overloadable_Kind =>
- return Typ = 's';
+ if Ekind (E) in Overloadable_Kind then
- -- References to IN parameters and constants are not
- -- considered in Alfa section, as these will be translated
- -- as constants in the intermediate language for formal
- -- verification, and should therefore never appear in frame
- -- conditions.
+ -- The only references of interest on callable entities are
+ -- calls. On non-callable entities, the only references of
+ -- interest are reads and writes.
- -- What about E_Loop_Parameter???
+ return Typ = 's';
+
+ elsif Is_Constant_Object (E) then
+
+ -- References to constant objects are not considered in Alfa
+ -- section, as these will be translated as constants in the
+ -- intermediate language for formal verification, and should
+ -- therefore never appear in frame conditions.
- when E_In_Parameter | E_Constant =>
return False;
- when others =>
+ elsif Present (Etype (E)) and then
+ Ekind (Etype (E)) in Concurrent_Kind then
- -- Objects of Task type or protected type are not Alfa
- -- references.
+ -- Objects of Task type or protected type are not Alfa
+ -- references.
- if Present (Etype (E))
- and then Ekind (Etype (E)) in Concurrent_Kind
- then
- return False;
- end if;
+ return False;
- return Typ = 'r' or else Typ = 'm';
- end case;
+ else
+ return Typ = 'r' or else Typ = 'm';
+
+ end if;
end Is_Alfa_Reference;
-------------------
-------------------------------
function Is_Immutably_Limited_Type (Ent : Entity_Id) return Boolean is
- Btype : constant Entity_Id := Base_Type (Ent);
+ Btype : constant Entity_Id := Available_View (Base_Type (Ent));
begin
if Is_Limited_Record (Btype) then
and then Nkind (Parent (Btype)) = N_Formal_Type_Declaration
then
return not In_Package_Body (Scope ((Btype)));
- end if;
- if Is_Private_Type (Btype) then
+ elsif Is_Private_Type (Btype) then
-- AI05-0063: A type derived from a limited private formal type is
-- not immutably limited in a generic body.
Tag_Mismatch;
end if;
end if;
+
if Present (Prev)
and then Nkind (Parent (Prev)) = N_Incomplete_Type_Declaration
and then Present (Premature_Use (Parent (Prev)))
Error_Msg_Node_2 := First_Subtype (Prefix_Type);
Error_Msg_NE ("no selector& for}", N, Sel);
- -- If prefix is incomplete, add information
+ -- Add information in the case of an incomplete prefix
if Is_Incomplete_Type (Type_To_Use) then
declare
if Nkind (Parent (Inc)) =
N_Incomplete_Type_Declaration
then
+ -- Record location of premature use in entity so that
+ -- a continuation message is generated when the
+ -- completion is seen.
+
Set_Premature_Use (Parent (Inc), N);
end if;
end if;
E, BIP_Formal_Suffix (BIP_Finalization_Master));
end if;
- -- If the result type contains tasks, we have two extra formals:
- -- the master of the tasks to be created, and the caller's
- -- activation chain.
+ -- When the result type contains tasks, add two extra formals: the
+ -- master of the tasks to be created, and the caller's activation
+ -- chain.
- if Has_Task (Result_Subt) then
+ if Has_Task (Available_View (Result_Subt)) then
Discard :=
Add_Extra_Formal
(E, RTE (RE_Master_Id),
projects / platform / upstream / linaro-gcc.git / commitdiff