[Ada] Transform_Function_Array issues
gcc/ada/ * exp_ch6.adb (Build_Procedure_Body_Form): Adjust, the declaration of the procedure form is now insert before the original function body rather than after. (Expand_N_Subprogram_Declaration): Deal with private types whose full views are arrays. * exp_unst.adb (Unnest_Subprogram): Deal with private types. (Needs_Fat_Pointer): Code cleanup. * freeze.adb (Freeze_Subprogram): Ditto. * exp_util.adb (Build_Procedure_Form): Insert the procedure form decl before and not after. * sem_ch6.adb (Analyze_Subprogram_Body_Helper): Build missing spec when needed for Transform_Function_Array. * sem_util.adb (Get_Fullest_View): Deal with null entity.
This commit is contained in:
Arnaud Charlet
Pierre-Marie de Rodat
parent
958eed88b9
commit
d79e7af5ff
6 changed files with 69 additions and 32 deletions
|
|
@ -883,9 +883,8 @@ package body Exp_Ch6 is
|
|||
is
|
||||
Loc : constant Source_Ptr := Sloc (Func_Body);
|
||||
|
||||
Proc_Decl : constant Node_Id :=
|
||||
Next (Unit_Declaration_Node (Func_Id));
|
||||
-- It is assumed that the next node following the declaration of the
|
||||
Proc_Decl : constant Node_Id := Prev (Unit_Declaration_Node (Func_Id));
|
||||
-- It is assumed that the node before the declaration of the
|
||||
-- corresponding subprogram spec is the declaration of the procedure
|
||||
-- form.
|
||||
|
||||
|
|
@ -6571,6 +6570,7 @@ package body Exp_Ch6 is
|
|||
Prot_Bod : Node_Id;
|
||||
Prot_Decl : Node_Id;
|
||||
Prot_Id : Entity_Id;
|
||||
Typ : Entity_Id;
|
||||
|
||||
begin
|
||||
-- Deal with case of protected subprogram. Do not generate protected
|
||||
|
|
@ -6645,10 +6645,12 @@ package body Exp_Ch6 is
|
|||
-- are not needed by the C generator (and this also produces cleaner
|
||||
-- output).
|
||||
|
||||
Typ := Get_Fullest_View (Etype (Subp));
|
||||
|
||||
if Transform_Function_Array
|
||||
and then Nkind (Specification (N)) = N_Function_Specification
|
||||
and then Is_Array_Type (Etype (Subp))
|
||||
and then Is_Constrained (Etype (Subp))
|
||||
and then Is_Array_Type (Typ)
|
||||
and then Is_Constrained (Typ)
|
||||
and then not Is_Unchecked_Conversion_Instance (Subp)
|
||||
then
|
||||
Build_Procedure_Form (N);
|
||||
|
|
|
|||
|
|
@ -251,13 +251,8 @@ package body Exp_Unst is
|
|||
-----------------------
|
||||
|
||||
function Needs_Fat_Pointer (E : Entity_Id) return Boolean is
|
||||
Typ : Entity_Id := Etype (E);
|
||||
|
||||
Typ : constant Entity_Id := Get_Fullest_View (Etype (E));
|
||||
begin
|
||||
if Is_Private_Type (Typ) and then Present (Full_View (Typ)) then
|
||||
Typ := Full_View (Typ);
|
||||
end if;
|
||||
|
||||
return Is_Array_Type (Typ) and then not Is_Constrained (Typ);
|
||||
end Needs_Fat_Pointer;
|
||||
|
||||
|
|
@ -898,6 +893,8 @@ package body Exp_Unst is
|
|||
DT : Boolean := False;
|
||||
Formal : Node_Id;
|
||||
Subp : Entity_Id;
|
||||
F_Type : Entity_Id;
|
||||
A_Type : Entity_Id;
|
||||
|
||||
begin
|
||||
if Nkind (Name (N)) = N_Explicit_Dereference then
|
||||
|
|
@ -908,12 +905,16 @@ package body Exp_Unst is
|
|||
|
||||
Actual := First_Actual (N);
|
||||
Formal := First_Formal_With_Extras (Subp);
|
||||
|
||||
while Present (Actual) loop
|
||||
if Is_Array_Type (Etype (Formal))
|
||||
and then not Is_Constrained (Etype (Formal))
|
||||
and then Is_Constrained (Etype (Actual))
|
||||
F_Type := Get_Fullest_View (Etype (Formal));
|
||||
A_Type := Get_Fullest_View (Etype (Actual));
|
||||
|
||||
if Is_Array_Type (F_Type)
|
||||
and then not Is_Constrained (F_Type)
|
||||
and then Is_Constrained (A_Type)
|
||||
then
|
||||
Check_Static_Type (Etype (Actual), Empty, DT);
|
||||
Check_Static_Type (A_Type, Empty, DT);
|
||||
end if;
|
||||
|
||||
Next_Actual (Actual);
|
||||
|
|
|
|||
|
|
@ -3994,9 +3994,11 @@ package body Exp_Util is
|
|||
Out_Present => True,
|
||||
Parameter_Type => New_Occurrence_Of (Etype (Subp), Loc)));
|
||||
|
||||
-- The new procedure declaration is inserted immediately after the
|
||||
-- function declaration. The processing in Build_Procedure_Body_Form
|
||||
-- relies on this order.
|
||||
-- The new procedure declaration is inserted before the function
|
||||
-- declaration. The processing in Build_Procedure_Body_Form relies on
|
||||
-- this order. Note that we insert before because in the case of a
|
||||
-- function body with no separate spec, we do not want to insert the
|
||||
-- new spec after the body which will later get rewritten.
|
||||
|
||||
Proc_Decl :=
|
||||
Make_Subprogram_Declaration (Loc,
|
||||
|
|
@ -4006,7 +4008,7 @@ package body Exp_Util is
|
|||
Make_Defining_Identifier (Loc, Chars (Subp)),
|
||||
Parameter_Specifications => Proc_Formals));
|
||||
|
||||
Insert_After_And_Analyze (Unit_Declaration_Node (Subp), Proc_Decl);
|
||||
Insert_Before_And_Analyze (Unit_Declaration_Node (Subp), Proc_Decl);
|
||||
|
||||
-- Entity of procedure must remain invisible so that it does not
|
||||
-- overload subsequent references to the original function.
|
||||
|
|
|
|||
|
|
@ -9225,10 +9225,12 @@ package body Freeze is
|
|||
Check_Overriding_Indicator (E, Empty, Is_Primitive (E));
|
||||
end if;
|
||||
|
||||
Retype := Get_Fullest_View (Etype (E));
|
||||
|
||||
if Transform_Function_Array
|
||||
and then Nkind (Parent (E)) = N_Function_Specification
|
||||
and then Is_Array_Type (Etype (E))
|
||||
and then Is_Constrained (Etype (E))
|
||||
and then Is_Array_Type (Retype)
|
||||
and then Is_Constrained (Retype)
|
||||
and then not Is_Unchecked_Conversion_Instance (E)
|
||||
and then not Rewritten_For_C (E)
|
||||
then
|
||||
|
|
|
|||
|
|
@ -4401,22 +4401,46 @@ package body Sem_Ch6 is
|
|||
|
||||
if Expander_Active
|
||||
and then Transform_Function_Array
|
||||
and then Present (Spec_Id)
|
||||
and then Ekind (Spec_Id) = E_Function
|
||||
and then Nkind (N) /= N_Subprogram_Body_Stub
|
||||
and then Rewritten_For_C (Spec_Id)
|
||||
then
|
||||
Set_Has_Completion (Spec_Id);
|
||||
declare
|
||||
S : constant Entity_Id :=
|
||||
(if Present (Spec_Id)
|
||||
then Spec_Id
|
||||
else Defining_Unit_Name (Specification (N)));
|
||||
Proc_Body : Node_Id;
|
||||
|
||||
Rewrite (N, Build_Procedure_Body_Form (Spec_Id, N));
|
||||
Analyze (N);
|
||||
begin
|
||||
if Ekind (S) = E_Function and then Rewritten_For_C (S) then
|
||||
Set_Has_Completion (S);
|
||||
Proc_Body := Build_Procedure_Body_Form (S, N);
|
||||
|
||||
-- The entity for the created procedure must remain invisible, so it
|
||||
-- does not participate in resolution of subsequent references to the
|
||||
-- function.
|
||||
if Present (Spec_Id) then
|
||||
Rewrite (N, Proc_Body);
|
||||
Analyze (N);
|
||||
|
||||
Set_Is_Immediately_Visible (Corresponding_Spec (N), False);
|
||||
goto Leave;
|
||||
-- The entity for the created procedure must remain
|
||||
-- invisible, so it does not participate in resolution of
|
||||
-- subsequent references to the function.
|
||||
|
||||
Set_Is_Immediately_Visible (Corresponding_Spec (N), False);
|
||||
|
||||
-- If we do not have a separate spec for N, build one and
|
||||
-- insert the new body right after.
|
||||
|
||||
else
|
||||
Rewrite (N,
|
||||
Make_Subprogram_Declaration (Loc,
|
||||
Specification => Relocate_Node (Specification (N))));
|
||||
Analyze (N);
|
||||
Insert_After_And_Analyze (N, Proc_Body);
|
||||
Set_Is_Immediately_Visible
|
||||
(Corresponding_Spec (Proc_Body), False);
|
||||
end if;
|
||||
|
||||
goto Leave;
|
||||
end if;
|
||||
end;
|
||||
end if;
|
||||
|
||||
-- If a separate spec is present, then deal with freezing issues
|
||||
|
|
|
|||
|
|
@ -10589,6 +10589,12 @@ package body Sem_Util is
|
|||
function Get_Fullest_View
|
||||
(E : Entity_Id; Include_PAT : Boolean := True) return Entity_Id is
|
||||
begin
|
||||
-- Prevent cascaded errors
|
||||
|
||||
if No (E) then
|
||||
return E;
|
||||
end if;
|
||||
|
||||
-- Strictly speaking, the recursion below isn't necessary, but
|
||||
-- it's both simplest and safest.
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue