Add_Extra_Actual_To_Call
(Function_Call, Alloc_Form_Formal, Alloc_Form_Actual);
- -- Pass the Storage_Pool parameter. This parameter is omitted
+ -- Pass the Storage_Pool parameter. This parameter is omitted on
-- .NET/JVM/ZFP as those targets do not support pools.
- if
- VM_Target = No_VM and then RTE_Available (RE_Root_Storage_Pool_Ptr)
+ if VM_Target = No_VM
+ and then RTE_Available (RE_Root_Storage_Pool_Ptr)
then
Pool_Formal := Build_In_Place_Formal (Function_Id, BIP_Storage_Pool);
Analyze_And_Resolve (Pool_Actual, Etype (Pool_Formal));
if not Is_Empty_List (Post_Call) then
- -- If call is not a list member, it must be the triggering statement
- -- of a triggering alternative or an entry call alternative, and we
- -- can add the post call stuff to the corresponding statement list.
+ -- Cases where the call is not a member of a statement list
if not Is_List_Member (N) then
declare
- P : constant Node_Id := Parent (N);
+ P : Node_Id := Parent (N);
begin
- pragma Assert (Nkind_In (P, N_Triggering_Alternative,
- N_Entry_Call_Alternative));
+ -- In Ada 2012 the call may be a function call in an expression
+ -- (since OUT and IN OUT parameters are now allowed for such
+ -- calls. The write-back of (in)-out parameters is handled
+ -- by the back-end, but the constraint checks generated when
+ -- subtypes of formal and actual don't match must be inserted
+ -- in the form of assignments, at the nearest point after the
+ -- declaration or statement that contains the call.
+
+ if Ada_Version >= Ada_2012
+ and then Nkind (N) = N_Function_Call
+ then
+ while Nkind (P) not in N_Declaration
+ and then
+ Nkind (P) not in N_Statement_Other_Than_Procedure_Call
+ loop
+ P := Parent (P);
+ end loop;
+
+ Insert_Actions_After (P, Post_Call);
+
+ -- If not the special Ada 2012 case of a function call, then
+ -- we must have the triggering statement of a triggering
+ -- alternative or an entry call alternative, and we can add
+ -- the post call stuff to the corresponding statement list.
- if Is_Non_Empty_List (Statements (P)) then
- Insert_List_Before_And_Analyze
- (First (Statements (P)), Post_Call);
else
- Set_Statements (P, Post_Call);
+ pragma Assert (Nkind_In (P, N_Triggering_Alternative,
+ N_Entry_Call_Alternative));
+
+ if Is_Non_Empty_List (Statements (P)) then
+ Insert_List_Before_And_Analyze
+ (First (Statements (P)), Post_Call);
+ else
+ Set_Statements (P, Post_Call);
+ end if;
end if;
+
end;
-- Otherwise, normal case where N is in a statement sequence,
end if;
end if;
- -- For Ada 2012, if a parameter is aliased, the actual must be an
- -- aliased object.
+ -- For Ada 2012, if a parameter is aliased, the actual must be a
+ -- tagged type or an aliased view of an object.
- if Is_Aliased (Formal) and then not Is_Aliased_View (Actual) then
+ if Is_Aliased (Formal)
+ and then not Is_Aliased_View (Actual)
+ and then not Is_Tagged_Type (Etype (Formal))
+ then
Error_Msg_NE
("actual for aliased formal& must be aliased object",
Actual, Formal);
Next_Formal (Formal);
end loop;
- -- If we are calling an Ada2012 function which needs to have the
+ -- If we are calling an Ada 2012 function which needs to have the
-- "accessibility level determined by the point of call" (AI05-0234)
-- passed in to it, then pass it in.
-- pool parameter on .NET/JVM/ZFP because the parameter
-- is not created in the first place.
- if VM_Target = No_VM and then
- RTE_Available (RE_Root_Storage_Pool_Ptr)
+ if VM_Target = No_VM
+ and then RTE_Available (RE_Root_Storage_Pool_Ptr)
then
Pool_Decl :=
Make_Object_Renaming_Declaration (Loc,
end if;
-- If local-exception-to-goto optimization active, insert dummy push
- -- statements at start, and dummy pop statements at end.
+ -- statements at start, and dummy pop statements at end, but inhibit
+ -- this if we have No_Exception_Handlers, since they are useless and
+ -- intefere with analysis, e.g. by codepeer.
if (Debug_Flag_Dot_G
or else Restriction_Active (No_Exception_Propagation))
+ and then not Restriction_Active (No_Exception_Handlers)
+ and then not CodePeer_Mode
and then Is_Non_Empty_List (L)
then
declare
Make_Explicit_Dereference (Loc,
Prefix => New_Reference_To (Temp, Loc)));
+ -- Ada 2005 (AI-251): If the type of the returned object is
+ -- an interface then add an implicit type conversion to force
+ -- displacement of the "this" pointer.
+
+ if Is_Interface (R_Type) then
+ Rewrite (Exp, Convert_To (R_Type, Relocate_Node (Exp)));
+ end if;
+
Analyze_And_Resolve (Exp, R_Type);
end;
-- to the object created by the allocator).
Rewrite (Allocator, Make_Reference (Loc, Relocate_Node (Function_Call)));
+
+ -- Ada 2005 (AI-251): If the type of the allocator is an interface then
+ -- generate an implicit conversion to force displacement of the "this"
+ -- pointer.
+
+ if Is_Interface (Designated_Type (Acc_Type)) then
+ Rewrite (Allocator, Convert_To (Acc_Type, Relocate_Node (Allocator)));
+ end if;
+
Analyze_And_Resolve (Allocator, Acc_Type);
end Make_Build_In_Place_Call_In_Allocator;
Obj_Id : Entity_Id;
Ptr_Typ : Entity_Id;
Ptr_Typ_Decl : Node_Id;
+ New_Expr : Node_Id;
Result_Subt : Entity_Id;
Target : Node_Id;
Insert_After_And_Analyze (Assign, Ptr_Typ_Decl);
-- Finally, create an access object initialized to a reference to the
- -- function call.
+ -- function call. We know this access value is non-null, so mark the
+ -- entity accordingly to suppress junk access checks.
+
+ New_Expr := Make_Reference (Loc, Relocate_Node (Func_Call));
- Obj_Id := Make_Temporary (Loc, 'R');
+ Obj_Id := Make_Temporary (Loc, 'R', New_Expr);
Set_Etype (Obj_Id, Ptr_Typ);
+ Set_Is_Known_Non_Null (Obj_Id);
Obj_Decl :=
Make_Object_Declaration (Loc,
Defining_Identifier => Obj_Id,
Object_Definition => New_Reference_To (Ptr_Typ, Loc),
- Expression => Make_Reference (Loc, Relocate_Node (Func_Call)));
+ Expression => New_Expr);
Insert_After_And_Analyze (Ptr_Typ_Decl, Obj_Decl);
Rewrite (Assign, Make_Null_Statement (Loc));
end if;
-- Finally, create an access object initialized to a reference to the
- -- function call.
+ -- function call. We know this access value cannot be null, so mark the
+ -- entity accordingly to suppress the access check.
New_Expr := Make_Reference (Loc, Relocate_Node (Func_Call));
Def_Id := Make_Temporary (Loc, 'R', New_Expr);
Set_Etype (Def_Id, Ref_Type);
+ Set_Is_Known_Non_Null (Def_Id);
Insert_After_And_Analyze (Ptr_Typ_Decl,
Make_Object_Declaration (Loc,
return False;
-- Handle a corner case, a cross-dialect subp renaming. For example,
- -- an Ada2012 renaming of an Ada05 subprogram. This can occur when a
- -- non-Ada2012 unit references predefined runtime units.
+ -- an Ada 2012 renaming of an Ada 2005 subprogram. This can occur when
+ -- an Ada 2005 (or earlier) unit references predefined run-time units.
elsif Present (Alias (Func_Id)) then
OSDN Git Service
