[Ada] Fix type mismatch in extended return statement expansion
This fixes a (sub)type mismatch in the expansion of an extended return statement generated for a built-in-place function that doesn't need a BIP_Alloc_Form parameter but returns unconstrained. No functional changes. 2019-08-21 Eric Botcazou <ebotcazou@adacore.com> gcc/ada/ * exp_ch6.adb (Expand_N_Extended_Return_Statement): In the case of a built-in-place function that doesn't need a BIP_Alloc_Form parameter but returns unconstrained, build the return consistently using the function's result subtype. Remove bypass added in previous change. From-SVN: r274782
This commit is contained in:
parent
92ef57728e
commit
bde9a2c227
|
@ -1,3 +1,11 @@
|
|||
2019-08-21 Eric Botcazou <ebotcazou@adacore.com>
|
||||
|
||||
* exp_ch6.adb (Expand_N_Extended_Return_Statement): In the case
|
||||
of a built-in-place function that doesn't need a BIP_Alloc_Form
|
||||
parameter but returns unconstrained, build the return
|
||||
consistently using the function's result subtype. Remove bypass
|
||||
added in previous change.
|
||||
|
||||
2019-08-21 Piotr Trojanek <trojanek@adacore.com>
|
||||
|
||||
* sem_prag.adb (Max_Entry_Queue_Length): Do not substitute
|
||||
|
|
|
@ -5199,7 +5199,7 @@ package body Exp_Ch6 is
|
|||
end if;
|
||||
|
||||
-- When the function's subtype is unconstrained, a run-time
|
||||
-- test is needed to determine the form of allocation to use
|
||||
-- test may be needed to decide the form of allocation to use
|
||||
-- for the return object. The function has an implicit formal
|
||||
-- parameter indicating this. If the BIP_Alloc_Form formal has
|
||||
-- the value one, then the caller has passed access to an
|
||||
|
@ -5235,13 +5235,6 @@ package body Exp_Ch6 is
|
|||
SS_Allocator : Node_Id;
|
||||
|
||||
begin
|
||||
-- Reuse the itype created for the function's implicit
|
||||
-- access formal. This avoids the need to create a new
|
||||
-- access type here, plus it allows assigning the access
|
||||
-- formal directly without applying a conversion.
|
||||
|
||||
-- Ref_Type := Etype (Object_Access);
|
||||
|
||||
-- Create an access type designating the function's
|
||||
-- result subtype.
|
||||
|
||||
|
@ -5570,6 +5563,64 @@ package body Exp_Ch6 is
|
|||
-- Remember the local access object for use in the
|
||||
-- dereference of the renaming created below.
|
||||
|
||||
Obj_Acc_Formal := Alloc_Obj_Id;
|
||||
end;
|
||||
|
||||
-- When the function's subtype is unconstrained and a run-time
|
||||
-- test is not needed, we nevertheless need to build the return
|
||||
-- using the function's result subtype.
|
||||
|
||||
elsif not Is_Constrained (Underlying_Type (Etype (Func_Id)))
|
||||
then
|
||||
declare
|
||||
Alloc_Obj_Id : Entity_Id;
|
||||
Alloc_Obj_Decl : Node_Id;
|
||||
Ptr_Type_Decl : Node_Id;
|
||||
Ref_Type : Entity_Id;
|
||||
|
||||
begin
|
||||
-- Create an access type designating the function's
|
||||
-- result subtype.
|
||||
|
||||
Ref_Type := Make_Temporary (Loc, 'A');
|
||||
|
||||
Ptr_Type_Decl :=
|
||||
Make_Full_Type_Declaration (Loc,
|
||||
Defining_Identifier => Ref_Type,
|
||||
Type_Definition =>
|
||||
Make_Access_To_Object_Definition (Loc,
|
||||
All_Present => True,
|
||||
Subtype_Indication =>
|
||||
New_Occurrence_Of (Ret_Obj_Typ, Loc)));
|
||||
|
||||
Insert_Before (Ret_Obj_Decl, Ptr_Type_Decl);
|
||||
|
||||
-- Create an access object initialized to the conversion
|
||||
-- of the implicit access value passed in by the caller.
|
||||
|
||||
Alloc_Obj_Id := Make_Temporary (Loc, 'R');
|
||||
Set_Etype (Alloc_Obj_Id, Ref_Type);
|
||||
|
||||
-- See the ??? comment a few lines above about the use of
|
||||
-- an unchecked conversion here.
|
||||
|
||||
Alloc_Obj_Decl :=
|
||||
Make_Object_Declaration (Loc,
|
||||
Defining_Identifier => Alloc_Obj_Id,
|
||||
Object_Definition =>
|
||||
New_Occurrence_Of (Ref_Type, Loc),
|
||||
Expression =>
|
||||
Make_Unchecked_Type_Conversion (Loc,
|
||||
Subtype_Mark =>
|
||||
New_Occurrence_Of (Ref_Type, Loc),
|
||||
Expression =>
|
||||
New_Occurrence_Of (Obj_Acc_Formal, Loc)));
|
||||
|
||||
Insert_Before (Ret_Obj_Decl, Alloc_Obj_Decl);
|
||||
|
||||
-- Remember the local access object for use in the
|
||||
-- dereference of the renaming created below.
|
||||
|
||||
Obj_Acc_Formal := Alloc_Obj_Id;
|
||||
end;
|
||||
end if;
|
||||
|
@ -5615,23 +5666,7 @@ package body Exp_Ch6 is
|
|||
Set_Comes_From_Extended_Return_Statement (Return_Stmt);
|
||||
|
||||
Rewrite (N, Result);
|
||||
|
||||
declare
|
||||
T : constant Entity_Id := Etype (Ret_Obj_Id);
|
||||
begin
|
||||
Analyze (N, Suppress => All_Checks);
|
||||
|
||||
-- In some cases, analysis of N can set the Etype of an N_Identifier
|
||||
-- to a subtype of the Etype of the Entity of the N_Identifier, which
|
||||
-- gigi doesn't like. Reset the Etypes correctly here.
|
||||
|
||||
if Nkind (Expression (Return_Stmt)) = N_Identifier
|
||||
and then Entity (Expression (Return_Stmt)) = Ret_Obj_Id
|
||||
then
|
||||
Set_Etype (Ret_Obj_Id, T);
|
||||
Set_Etype (Expression (Return_Stmt), T);
|
||||
end if;
|
||||
end;
|
||||
Analyze (N, Suppress => All_Checks);
|
||||
end Expand_N_Extended_Return_Statement;
|
||||
|
||||
----------------------------
|
||||
|
|
Loading…
Reference in New Issue