In the case a class-wide limited (build-in-place) function that returns
a call to another build-in-place function with a controlled result, the
compiler passes null as the value for the implicit finalization master
parameter rather than passing along its own finalization master formal.
This fails a null access check in the case where the class-wide function
is called to initialize an alloctor. The implicit formal must be passed
along if the outer function calls another function (necessarily also
build-in-place) in a return statement.
The following test must compile and execute quietly with -gnat05:
with Ada.Finalization; use Ada.Finalization;
package Ctrlled_BIP_Pkg is
type Update_Lock is limited new Limited_Controlled with null record;
function Lock_Updates return Update_Lock;
type Update_Lock_Access is access all Update_Lock'Class;
end Ctrlled_BIP_Pkg;
package body Ctrlled_BIP_Pkg is
function Lock_Updates return Update_Lock is
begin
return (Limited_Controlled with others => <>);
end Lock_Updates;
end Ctrlled_BIP_Pkg;
with Ctrlled_BIP_Pkg; use Ctrlled_BIP_Pkg;
procedure Ctrlled_BIP_Bug is
function Wrapper return Ctrlled_BIP_Pkg.Update_Lock'Class is
begin
return Ctrlled_BIP_Pkg.Lock_Updates;
end Wrapper;
Lock : Update_Lock_Access;
begin
Lock := new Update_Lock'Class'(Wrapper);
end Ctrlled_BIP_Bug;
Tested on x86_64-pc-linux-gnu, committed on trunk
2011-09-02 Gary Dismukes <dismu...@adacore.com>
* exp_ch6.adb (Add_Finalization_Master_Actual_To_Build_In_Place_Call):
Add new formal Master_Exp. When present, add that expression to the
call as an extra actual.
(Make_Build_In_Place_Call_In_Object_Declaration): Add variable
Fmaster_Actual and in the case of a BIP call initializing a return
object of an enclosing BIP function set it to a
new reference to the implicit finalization master
formal of the enclosing function. Fmaster_Actual is
then passed to the new formal Master_Exp on the call to
Add_Finalization_Master_Actual_To_Build_ In_Place_Call. Move
initializations of Enclosing_Func to its declaration.
Index: exp_ch6.adb
===================================================================
--- exp_ch6.adb (revision 178433)
+++ exp_ch6.adb (working copy)
@@ -111,13 +111,15 @@
-- Extra_Formal in Subprogram_Call.
procedure Add_Finalization_Master_Actual_To_Build_In_Place_Call
- (Func_Call : Node_Id;
- Func_Id : Entity_Id;
- Ptr_Typ : Entity_Id := Empty);
+ (Func_Call : Node_Id;
+ Func_Id : Entity_Id;
+ Ptr_Typ : Entity_Id := Empty;
+ Master_Exp : Node_Id := Empty);
-- Ada 2005 (AI-318-02): If the result type of a build-in-place call needs
-- finalization actions, add an actual parameter which is a pointer to the
- -- finalization master of the caller. If Ptr_Typ is left Empty, this will
- -- result in an automatic "null" value for the actual.
+ -- finalization master of the caller. If Master_Exp is not Empty, then that
+ -- will be passed as the actual. Otherwise, if Ptr_Typ is left Empty, this
+ -- will result in an automatic "null" value for the actual.
procedure Add_Task_Actuals_To_Build_In_Place_Call
(Function_Call : Node_Id;
@@ -311,9 +313,10 @@
-----------------------------------------------------------
procedure Add_Finalization_Master_Actual_To_Build_In_Place_Call
- (Func_Call : Node_Id;
- Func_Id : Entity_Id;
- Ptr_Typ : Entity_Id := Empty)
+ (Func_Call : Node_Id;
+ Func_Id : Entity_Id;
+ Ptr_Typ : Entity_Id := Empty;
+ Master_Exp : Node_Id := Empty)
is
begin
if not Needs_BIP_Finalization_Master (Func_Id) then
@@ -329,9 +332,16 @@
Desig_Typ : Entity_Id;
begin
+ -- If there is a finalization master actual, such as the implicit
+ -- finalization master of an enclosing build-in-place function,
+ -- then this must be added as an extra actual of the call.
+
+ if Present (Master_Exp) then
+ Actual := Master_Exp;
+
-- Case where the context does not require an actual master
- if No (Ptr_Typ) then
+ elsif No (Ptr_Typ) then
Actual := Make_Null (Loc);
else
@@ -7561,7 +7571,9 @@
Ptr_Typ_Decl : Node_Id;
Def_Id : Entity_Id;
New_Expr : Node_Id;
- Enclosing_Func : Entity_Id;
+ Enclosing_Func : constant Entity_Id :=
+ Enclosing_Subprogram (Obj_Def_Id);
+ Fmaster_Actual : Node_Id := Empty;
Pass_Caller_Acc : Boolean := False;
begin
@@ -7613,8 +7625,6 @@
if Is_Return_Object (Defining_Identifier (Object_Decl)) then
Pass_Caller_Acc := True;
- Enclosing_Func := Enclosing_Subprogram (Obj_Def_Id);
-
-- When the enclosing function has a BIP_Alloc_Form formal then we
-- pass it along to the callee (such as when the enclosing function
-- has an unconstrained or tagged result type).
@@ -7636,6 +7646,13 @@
(Func_Call, Function_Id, Alloc_Form => Caller_Allocation);
end if;
+ if Needs_BIP_Finalization_Master (Enclosing_Func) then
+ Fmaster_Actual :=
+ New_Reference_To
+ (Build_In_Place_Formal
+ (Enclosing_Func, BIP_Finalization_Master), Loc);
+ end if;
+
-- Retrieve the BIPacc formal from the enclosing function and convert
-- it to the access type of the callee's BIP_Object_Access formal.
@@ -7686,14 +7703,18 @@
Establish_Transient_Scope (Object_Decl, Sec_Stack => True);
end if;
+ -- Pass along any finalization master actual, which is needed in the
+ -- case where the called function initializes a return object of an
+ -- enclosing build-in-place function.
+
Add_Finalization_Master_Actual_To_Build_In_Place_Call
- (Func_Call, Function_Id);
+ (Func_Call => Func_Call,
+ Func_Id => Function_Id,
+ Master_Exp => Fmaster_Actual);
if Nkind (Parent (Object_Decl)) = N_Extended_Return_Statement
and then Has_Task (Result_Subt)
then
- Enclosing_Func := Enclosing_Subprogram (Obj_Def_Id);
-
-- Here we're passing along the master that was passed in to this
-- function.
