* [Ada] Transform_Function_Array issues
@ 2020-12-15 11:42 Pierre-Marie de Rodat
0 siblings, 0 replies; only message in thread
From: Pierre-Marie de Rodat @ 2020-12-15 11:42 UTC (permalink / raw)
To: gcc-patches; +Cc: Arnaud Charlet
[-- Attachment #1: Type: text/plain, Size: 936 bytes --]
As shown by ACATS c74209a, there are remaining cases where the
Transform_Function_Array does not trigger properly, related to private
types on one hand, and to freezing of function with no separate spec on
the other hand.
Tested on x86_64-pc-linux-gnu, committed on trunk
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.
[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 8318 bytes --]
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -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);
diff --git a/gcc/ada/exp_unst.adb b/gcc/ada/exp_unst.adb
--- a/gcc/ada/exp_unst.adb
+++ b/gcc/ada/exp_unst.adb
@@ -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);
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -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.
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -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
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -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
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -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.
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2020-12-15 11:42 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2020-12-15 11:42 [Ada] Transform_Function_Array issues Pierre-Marie de Rodat
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).