diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 955049f421015d7b8de0ce2d1eafdc04d5def673..0a5fbccec820ee515b618c9ff0d18428ed8ee4f7 100644
--- 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
index e0f2bd1c6c007c06bd5fa16641cce33692e75b77..ee2cf8113dc90e443a3659dd4cebbb251b4a0b5d 100644
--- 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
index 21098b7c057b0e4705e684416ba9d1a1d80db2dd..bcfedfb32bd886aab278fa423b58d08ad23d4921 100644
--- 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
index 098b117cf840c27771049521ca85ee2b0414a980..b877b441de8b032e086c43d4030b674526f46a2c 100644
--- 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
index 35e13a5750a3489a85236410dc04dc941b8f37b9..9aff0f591938297f2bde93e239ffd9bd0534fe3d 100644
--- 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
index 063860af48c42075426a6f985054707386030c37..c695cbc5266b6f77139d395b976245a49368a5a4 100644
--- 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.