procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

ada: Fix bogus error on allocator in instantiation with private derived types

Browse source 
The problem is that the call to Convert_View made from Make_Init_Call does
nothing because the Etype is not set on the second argument.

gcc/ada/

	* exp_ch7.adb (Convert_View): Add third parameter Typ and use it if
	the second parameter does not have an Etype.
	(Make_Adjust_Call): Remove obsolete setting of Etype and pass Typ in
	call to Convert_View.
	(Make_Final_Call): Likewise.
	(Make_Init_Call): Pass Typ in call to Convert_View.
This commit is contained in:
Eric Botcazou 2024-06-17 21:22:06 +02:00 • committed by Marc Poulhiès
parent 9fbf6517c7
commit 693985f4d8
1 changed files with 21 additions and 30 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

51
gcc/ada/exp_ch7.adb
View file

@ -563,12 +563,16 @@ package body Exp_Ch7 is
-- Check recursively whether a loop or block contains a subprogram that
-- may need an activation record.
function Convert_View (Proc : Entity_Id; Arg : Node_Id) return Node_Id;
-- Proc is one of the Initialize/Adjust/Finalize operations, and Arg is the
-- argument being passed to it. This function will, if necessary, generate
-- a conversion between the partial and full view of Arg to match the type
-- of the formal of Proc, or force a conversion to the class-wide type in
-- the case where the operation is abstract.
function Convert_View
(Proc : Entity_Id;
Arg : Node_Id;
Typ : Entity_Id) return Node_Id;
-- Proc is one of the Initialize/Adjust/Finalize operations, Arg is the one
-- argument being passed to it, and Typ is its expected type. This function
-- will, if necessary, generate a conversion between the partial and full
-- views of Arg to match the type of the formal of Proc, or else force a
-- conversion to the class-wide type in the case where the operation is
-- abstract.
function Make_Call
(Loc : Source_Ptr;
@ -4023,7 +4027,11 @@ package body Exp_Ch7 is
-- Convert_View --
------------------
function Convert_View (Proc : Entity_Id; Arg : Node_Id) return Node_Id is
function Convert_View
(Proc : Entity_Id;
Arg : Node_Id;
Typ : Entity_Id) return Node_Id
is
Ftyp : constant Entity_Id := Etype (First_Formal (Proc));
Atyp : Entity_Id;
@ -4031,8 +4039,10 @@ package body Exp_Ch7 is
begin
if Nkind (Arg) in N_Type_Conversion | N_Unchecked_Type_Conversion then
Atyp := Entity (Subtype_Mark (Arg));
else
elsif Present (Etype (Arg)) then
Atyp := Etype (Arg);
else
Atyp := Typ;
end if;
if Is_Abstract_Subprogram (Proc) and then Is_Tagged_Type (Ftyp) then
@ -5452,21 +5462,11 @@ package body Exp_Ch7 is
end if;
if Present (Adj_Id) then
-- If the object is unanalyzed, set its expected type for use in
-- Convert_View in case an additional conversion is needed.
if No (Etype (Ref))
and then Nkind (Ref) /= N_Unchecked_Type_Conversion
then
Set_Etype (Ref, Typ);
end if;
-- The object reference may need another conversion depending on the
-- type of the formal and that of the actual.
if not Is_Class_Wide_Type (Typ) then
Ref := Convert_View (Adj_Id, Ref);
Ref := Convert_View (Adj_Id, Ref, Typ);
end if;
return
@ -7849,16 +7849,7 @@ package body Exp_Ch7 is
end if;
end;
-- If the object is unanalyzed, set its expected type for use in
-- Convert_View in case an additional conversion is needed.
if No (Etype (Ref))
and then Nkind (Ref) /= N_Unchecked_Type_Conversion
then
Set_Etype (Ref, Typ);
end if;
Ref := Convert_View (Fin_Id, Ref);
Ref := Convert_View (Fin_Id, Ref, Typ);
end if;
return
@ -8314,7 +8305,7 @@ package body Exp_Ch7 is
-- The object reference may need another conversion depending on the
-- type of the formal and that of the actual.
Ref := Convert_View (Proc, Ref);
Ref := Convert_View (Proc, Ref, Typ);
-- Generate:
-- [Deep_]Initialize (Ref);