The compiler incorrectly reports an error about "uninitialized unconstrained
allocation" on a call to a limited build-in-place function when the result type
has a partial view with unknown discriminants, the full view is constrained and
the call is the expression of a return for an enclosing build-in-place function.
The build-in-place expansion process treats the return statement and the call
inconsistently with respect to constrained vs. unconstrained properties,
resulting in full build-in-place return statement expansion that causes an
illegal allocator to be created (returning the unconstrained partial view).
The correction is to handle all cases where a return expression in a
build-in-place function is itself a build-in-place call by simply passing
along the implicit build-in-place parameters of the enclosing function,
which is more efficient in any case and will possibliy also fix some latent
bug cases.
The following test must compile and execute quietly with -gnat05:
package Unk_Discrim_BIP_Pkg is
type Root is new Ada.Finalization.Limited_Controlled with null record;
type Priv_With_Unk_Discrims (<>) is new Root with private;
function Specific_BIP_Func return Priv_With_Unk_Discrims;
function Value (Obj : Priv_With_Unk_Discrims) return Integer;
private
type Priv_With_Unk_Discrims is new Root with record
I : Integer := 0;
end record;
end Unk_Discrim_BIP_Pkg;
package body Unk_Discrim_BIP_Pkg is
function Specific_BIP_Func return Priv_With_Unk_Discrims is
begin
return Result : Priv_With_Unk_Discrims do
Result.I := 123;
end return;
end Specific_BIP_Func;
function Value (Obj : Priv_With_Unk_Discrims) return Integer is
begin
return Obj.I;
end Value;
end Unk_Discrim_BIP_Pkg;
with Unk_Discrim_BIP_Pkg; use Unk_Discrim_BIP_Pkg;
procedure Unk_Discrim_BIP_Bug is
function Class_Wide_BIP_Func return Root'Class is
begin
return Specific_BIP_Func;
end Class_Wide_BIP_Func;
begin
if Value (Priv_With_Unk_Discrims (Class_Wide_BIP_Func)) /= 123 then
raise Program_Error;
end if;
end Unk_Discrim_BIP_Bug;
Tested on x86_64-pc-linux-gnu, committed on trunk
2011-09-01 Gary Dismukes <dismu...@adacore.com>
* exp_ch6.ads (Needs_BIP_Alloc_Form): New utility function.
* exp_ch6.adb (Make_Build_In_Place_Call_In_Object_Declaration):
Test for case where call
initializes an object of a return statement before testing for
a constrained call, to ensure that all such cases get handled
by simply passing on the caller's parameters. Also, in that
case call Needs_BIP_Alloc_Form to determine whether to pass on
the BIP_Alloc_Form parameter of the enclosing function rather
than testing Is_Constrained. Add similar tests for the return
of a BIP call to later processing to ensure consistent handling.
(Needs_BIP_Alloc_Form): New utility function.
* sem_ch6.adb: (Create_Extra_Formals): Replace test for adding
a BIP_Alloc_Form formal with call to new utility function
Needs_BIP_Alloc_Form.
Index: exp_ch6.adb
===================================================================
--- exp_ch6.adb (revision 178410)
+++ exp_ch6.adb (working copy)
@@ -4198,7 +4198,6 @@
Constant_Present => True,
Object_Definition => New_Occurrence_Of (Temp_Typ, Loc),
Expression => New_A);
-
else
Decl :=
Make_Object_Renaming_Declaration (Loc,
@@ -7579,61 +7578,40 @@
Result_Subt := Etype (Function_Id);
- -- In the constrained case, add an implicit actual to the function call
- -- that provides access to the declared object. An unchecked conversion
- -- to the (specific) result type of the function is inserted to handle
- -- the case where the object is declared with a class-wide type.
+ -- If the the object is a return object of an enclosing build-in-place
+ -- function, then the implicit build-in-place parameters of the
+ -- enclosing function are simply passed along to the called function.
+ -- (Unfortunately, this won't cover the case of extension aggregates
+ -- where the ancestor part is a build-in-place unconstrained function
+ -- call that should be passed along the caller's parameters. Currently
+ -- those get mishandled by reassigning the result of the call to the
+ -- aggregate return object, when the call result should really be
+ -- directly built in place in the aggregate and not in a temporary. ???)
- if Is_Constrained (Underlying_Type (Result_Subt)) then
- Caller_Object :=
- Make_Unchecked_Type_Conversion (Loc,
- Subtype_Mark => New_Reference_To (Result_Subt, Loc),
- Expression => New_Reference_To (Obj_Def_Id, Loc));
-
- -- When the function has a controlling result, an allocation-form
- -- parameter must be passed indicating that the caller is allocating
- -- the result object. This is needed because such a function can be
- -- called as a dispatching operation and must be treated similarly
- -- to functions with unconstrained result subtypes.
-
- Add_Alloc_Form_Actual_To_Build_In_Place_Call
- (Func_Call, Function_Id, Alloc_Form => Caller_Allocation);
-
- -- If the function's result subtype is unconstrained and the object is
- -- a return object of an enclosing build-in-place function, then the
- -- implicit build-in-place parameters of the enclosing function must be
- -- passed along to the called function. (Unfortunately, this won't cover
- -- the case of extension aggregates where the ancestor part is a build-
- -- in-place unconstrained function call that should be passed along the
- -- caller's parameters. Currently those get mishandled by reassigning
- -- the result of the call to the aggregate return object, when the call
- -- result should really be directly built in place in the aggregate and
- -- not built in a temporary. ???)
-
- elsif Is_Return_Object (Defining_Identifier (Object_Decl)) then
+ if Is_Return_Object (Defining_Identifier (Object_Decl)) then
Pass_Caller_Acc := True;
Enclosing_Func := Enclosing_Subprogram (Obj_Def_Id);
- -- If the enclosing function has a constrained result type, then
- -- caller allocation will be used.
+ -- 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).
- if Is_Constrained (Etype (Enclosing_Func)) then
+ if Needs_BIP_Alloc_Form (Enclosing_Func) then
Add_Alloc_Form_Actual_To_Build_In_Place_Call
- (Func_Call, Function_Id, Alloc_Form => Caller_Allocation);
-
- -- Otherwise, when the enclosing function has an unconstrained result
- -- type, the BIP_Alloc_Form formal of the enclosing function must be
- -- passed along to the callee.
-
- else
- Add_Alloc_Form_Actual_To_Build_In_Place_Call
(Func_Call,
Function_Id,
Alloc_Form_Exp =>
New_Reference_To
(Build_In_Place_Formal (Enclosing_Func, BIP_Alloc_Form),
Loc));
+
+ -- Otherwise, if enclosing function has a constrained result subtype,
+ -- then caller allocation will be used.
+
+ else
+ Add_Alloc_Form_Actual_To_Build_In_Place_Call
+ (Func_Call, Function_Id, Alloc_Form => Caller_Allocation);
end if;
-- Retrieve the BIPacc formal from the enclosing function and convert
@@ -7651,6 +7629,26 @@
(Build_In_Place_Formal (Enclosing_Func, BIP_Object_Access),
Loc));
+ -- In the constrained case, add an implicit actual to the function call
+ -- that provides access to the declared object. An unchecked conversion
+ -- to the (specific) result type of the function is inserted to handle
+ -- the case where the object is declared with a class-wide type.
+
+ elsif Is_Constrained (Underlying_Type (Result_Subt)) then
+ Caller_Object :=
+ Make_Unchecked_Type_Conversion (Loc,
+ Subtype_Mark => New_Reference_To (Result_Subt, Loc),
+ Expression => New_Reference_To (Obj_Def_Id, Loc));
+
+ -- When the function has a controlling result, an allocation-form
+ -- parameter must be passed indicating that the caller is allocating
+ -- the result object. This is needed because such a function can be
+ -- called as a dispatching operation and must be treated similarly
+ -- to functions with unconstrained result subtypes.
+
+ Add_Alloc_Form_Actual_To_Build_In_Place_Call
+ (Func_Call, Function_Id, Alloc_Form => Caller_Allocation);
+
-- In other unconstrained cases, pass an indication to do the allocation
-- on the secondary stack and set Caller_Object to Empty so that a null
-- value will be passed for the caller's object address. A transient
@@ -7710,11 +7708,14 @@
-- The access type and its accompanying object must be inserted after
-- the object declaration in the constrained case, so that the function
-- call can be passed access to the object. In the unconstrained case,
- -- the access type and object must be inserted before the object, since
- -- the object declaration is rewritten to be a renaming of a dereference
- -- of the access object.
+ -- or if the object declaration is for a return object, the access type
+ -- and object must be inserted before the object, since the object
+ -- declaration is rewritten to be a renaming of a dereference of the
+ -- access object.
- if Is_Constrained (Underlying_Type (Result_Subt)) then
+ if Is_Constrained (Underlying_Type (Result_Subt))
+ and then not Is_Return_Object (Defining_Identifier (Object_Decl))
+ then
Insert_After_And_Analyze (Object_Decl, Ptr_Typ_Decl);
else
Insert_Action (Object_Decl, Ptr_Typ_Decl);
@@ -7734,11 +7735,18 @@
Object_Definition => New_Reference_To (Ref_Type, Loc),
Expression => New_Expr));
- if Is_Constrained (Underlying_Type (Result_Subt)) then
+ -- If the result subtype of the called function is constrained and
+ -- is not itself the return expression of an enclosing BIP function,
+ -- then mark the object as having no initialization.
+
+ if Is_Constrained (Underlying_Type (Result_Subt))
+ and then not Is_Return_Object (Defining_Identifier (Object_Decl))
+ then
Set_Expression (Object_Decl, Empty);
Set_No_Initialization (Object_Decl);
- -- In case of an unconstrained result subtype, rewrite the object
+ -- In case of an unconstrained result subtype, or if the call is the
+ -- return expression of an enclosing BIP function, rewrite the object
-- declaration as an object renaming where the renamed object is a
-- dereference of <function_Call>'reference:
--
@@ -7830,4 +7838,16 @@
and then Needs_Finalization (Func_Typ);
end Needs_BIP_Finalization_Master;
+ --------------------------
+ -- Needs_BIP_Alloc_Form --
+ --------------------------
+
+ function Needs_BIP_Alloc_Form (Func_Id : Entity_Id) return Boolean is
+ pragma Assert (Is_Build_In_Place_Function (Func_Id));
+ Func_Typ : constant Entity_Id := Underlying_Type (Etype (Func_Id));
+
+ begin
+ return not Is_Constrained (Func_Typ) or else Is_Tagged_Type (Func_Typ);
+ end Needs_BIP_Alloc_Form;
+
end Exp_Ch6;
Index: exp_ch6.ads
===================================================================
--- exp_ch6.ads (revision 178381)
+++ exp_ch6.ads (working copy)
@@ -198,7 +198,11 @@
-- node applied to such a function call.
function Needs_BIP_Finalization_Master (Func_Id : Entity_Id) return Boolean;
- -- Ada 2005 (AI-318-02): Return True if the function needs a finalization
- -- master implicit parameter.
+ -- Ada 2005 (AI-318-02): Return True if the function needs an implicit
+ -- finalization master implicit parameter.
+ function Needs_BIP_Alloc_Form (Func_Id : Entity_Id) return Boolean;
+ -- Ada 2005 (AI-318-02): Return True if the function needs an implicit
+ -- BIP_Alloc_Form parameter (see type BIP_Formal_Kind).
+
end Exp_Ch6;
Index: sem_ch6.adb
===================================================================
--- sem_ch6.adb (revision 178407)
+++ sem_ch6.adb (working copy)
@@ -6120,9 +6120,7 @@
-- dispatching context and such calls must be handled like calls
-- to a class-wide function.
- if not Is_Constrained (Underlying_Type (Result_Subt))
- or else Is_Tagged_Type (Underlying_Type (Result_Subt))
- then
+ if Needs_BIP_Alloc_Form (E) then
Discard :=
Add_Extra_Formal
(E, Standard_Natural,
