This patch fixes a few minor glitches that yield small irregularities in the
expanded code handed down to gigi, for example the declaration of subprograms
before that of the type of their parameters, types that are neither regular
nor Itypes, or return types with circularities. No functional change.
Tested on x86_64-suse-linux, applied on the mainline.
2016-06-06 Eric Botcazou <ebotca...@adacore.com>
* exp_ch9.adb (Expand_N_Protected_Type_Declaration): Insert the
declaration of the corresponding record type before that of the
unprotected version of the subprograms that operate on it.
(Expand_Access_Protected_Subprogram_Type): Declare the
Equivalent_Type just before the original type.
* sem_ch3.adb (Handle_Late_Controlled_Primitive): Point the current
declaration to the newly created declaration for the primitive.
(Analyze_Subtype_Declaration): Remove obsolete code forcing the
freezing of the subtype before its declaration.
(Replace_Anonymous_Access_To_Protected_Subprogram): Insert the new
declaration in the nearest enclosing scope for formal parameters too.
(Build_Derived_Access_Type): Restore the status of the created Itype
after it is erased by Copy_Node.
* sem_ch6.adb (Exchange_Limited_Views): Remove guard on entry.
(Analyze_Subprogram_Body_Helper): Call Exchange_Limited_Views only if
the specification is present.
Move around the code changing the designated view of the return type
and save the original view. Restore it on exit.
* sem_ch13.adb (Build_Predicate_Function_Declaration): Always insert
the declaration right after that of the type.
--
Eric BotcazouIndex: exp_ch9.adb
===================================================================
--- exp_ch9.adb (revision 237088)
+++ exp_ch9.adb (working copy)
@@ -6257,7 +6257,10 @@ package body Exp_Ch9 is
Defining_Identifier => D_T2,
Type_Definition => Def1);
- Insert_After_And_Analyze (N, Decl1);
+ -- Declare the new types before the original one since the latter will
+ -- refer to them through the Equivalent_Type slot.
+
+ Insert_Before_And_Analyze (N, Decl1);
-- Associate the access to subprogram with its original access to
-- protected subprogram type. Needed by the backend to know that this
@@ -6292,7 +6295,7 @@ package body Exp_Ch9 is
Component_List =>
Make_Component_List (Loc, Component_Items => Comps)));
- Insert_After_And_Analyze (Decl1, Decl2);
+ Insert_Before_And_Analyze (N, Decl2);
Set_Equivalent_Type (T, E_T);
end Expand_Access_Protected_Subprogram_Type;
@@ -9316,6 +9319,9 @@ package body Exp_Ch9 is
pragma Assert (Present (Pdef));
+ Insert_After (Current_Node, Rec_Decl);
+ Current_Node := Rec_Decl;
+
-- Add private field components
if Present (Private_Declarations (Pdef)) then
@@ -9576,9 +9582,6 @@ package body Exp_Ch9 is
Append_To (Cdecls, Object_Comp);
end if;
- Insert_After (Current_Node, Rec_Decl);
- Current_Node := Rec_Decl;
-
-- Analyze the record declaration immediately after construction,
-- because the initialization procedure is needed for single object
-- declarations before the next entity is analyzed (the freeze call
Index: sem_ch13.adb
===================================================================
--- sem_ch13.adb (revision 237088)
+++ sem_ch13.adb (working copy)
@@ -9386,11 +9386,7 @@ package body Sem_Ch13 is
Set_Is_Predicate_Function (SId);
Set_Predicate_Function (Typ, SId);
- if Comes_From_Source (Typ) then
- Insert_After (Parent (Typ), FDecl);
- else
- Insert_After (Parent (Base_Type (Typ)), FDecl);
- end if;
+ Insert_After (Parent (Typ), FDecl);
Analyze (FDecl);
Index: sem_ch3.adb
===================================================================
--- sem_ch3.adb (revision 237088)
+++ sem_ch3.adb (working copy)
@@ -2168,7 +2168,7 @@ package body Sem_Ch3 is
-- Determine whether Body_Decl denotes the body of a late controlled
-- primitive (either Initialize, Adjust or Finalize). If this is the
-- case, add a proper spec if the body lacks one. The spec is inserted
- -- before Body_Decl and immedately analyzed.
+ -- before Body_Decl and immediately analyzed.
procedure Remove_Visible_Refinements (Spec_Id : Entity_Id);
-- Spec_Id is the entity of a package that may define abstract states.
@@ -2269,8 +2269,12 @@ package body Sem_Ch3 is
Set_Null_Present (Spec, False);
- Insert_Before_And_Analyze (Body_Decl,
- Make_Subprogram_Declaration (Loc, Specification => Spec));
+ -- Ensure that the freeze node is inserted after the declaration of
+ -- the primitive since its expansion will freeze the primitive.
+
+ Decl := Make_Subprogram_Declaration (Loc, Specification => Spec);
+
+ Insert_Before_And_Analyze (Body_Decl, Decl);
end Handle_Late_Controlled_Primitive;
--------------------------------
@@ -5246,20 +5250,6 @@ package body Sem_Ch3 is
Set_Invariant_Procedure (Id, Invariant_Procedure (T));
end if;
- -- Make sure that generic actual types are properly frozen. The subtype
- -- is marked as a generic actual type when the enclosing instance is
- -- analyzed, so here we identify the subtype from the tree structure.
-
- if Expander_Active
- and then Is_Generic_Actual_Type (Id)
- and then In_Instance
- and then not Comes_From_Source (N)
- and then Nkind (Subtype_Indication (N)) /= N_Subtype_Indication
- and then Is_Frozen (T)
- then
- Freeze_Before (N, Id);
- end if;
-
Set_Optimize_Alignment_Flags (Id);
Check_Eliminated (Id);
@@ -5851,15 +5841,20 @@ package body Sem_Ch3 is
end if;
-- Insert the new declaration in the nearest enclosing scope. If the
- -- node is a body and N is its return type, the declaration belongs in
- -- the enclosing scope.
+ -- parent is a body and N is its return type, the declaration belongs
+ -- in the enclosing scope. Likewise if N is the type of a parameter.
P := Parent (N);
- if Nkind (P) = N_Subprogram_Body
- and then Nkind (N) = N_Function_Specification
+ if Nkind (N) = N_Function_Specification
+ and then Nkind (P) = N_Subprogram_Body
then
P := Parent (P);
+ elsif Nkind (N) = N_Parameter_Specification
+ and then Nkind (P) in N_Subprogram_Specification
+ and then Nkind (Parent (P)) = N_Subprogram_Body
+ then
+ P := Parent (Parent (P));
end if;
while Present (P) and then not Has_Declarations (P) loop
@@ -5974,6 +5969,11 @@ package body Sem_Ch3 is
begin
Copy_Node (Pbase, Ibase);
+ -- Restore Itype status after Copy_Node
+
+ Set_Is_Itype (Ibase);
+ Set_Associated_Node_For_Itype (Ibase, N);
+
Set_Chars (Ibase, Svg_Chars);
Set_Next_Entity (Ibase, Svg_Next_E);
Set_Sloc (Ibase, Sloc (Derived_Type));
Index: sem_ch6.adb
===================================================================
--- sem_ch6.adb (revision 237088)
+++ sem_ch6.adb (working copy)
@@ -2149,6 +2149,7 @@ package body Sem_Ch6 is
Body_Id : Entity_Id := Defining_Entity (Body_Spec);
Prev_Id : constant Entity_Id := Current_Entity_In_Scope (Body_Id);
Exch_Views : Elist_Id := No_Elist;
+ Desig_View : Entity_Id := Empty;
Conformant : Boolean;
HSS : Node_Id;
Prot_Typ : Entity_Id := Empty;
@@ -2914,13 +2915,10 @@ package body Sem_Ch6 is
-- Start of processing for Exchange_Limited_Views
begin
- if No (Subp_Id) then
- return No_Elist;
-
-- Do not process subprogram bodies as they already use the non-
-- limited view of types.
- elsif not Ekind_In (Subp_Id, E_Function, E_Procedure) then
+ if not Ekind_In (Subp_Id, E_Function, E_Procedure) then
return No_Elist;
end if;
@@ -3665,31 +3663,6 @@ package body Sem_Ch6 is
Set_SPARK_Pragma_Inherited (Body_Id);
end if;
- -- If the return type is an anonymous access type whose designated type
- -- is the limited view of a class-wide type and the non-limited view is
- -- available, update the return type accordingly.
-
- if Ada_Version >= Ada_2005 and then Comes_From_Source (N) then
- declare
- Etyp : Entity_Id;
- Rtyp : Entity_Id;
-
- begin
- Rtyp := Etype (Current_Scope);
-
- if Ekind (Rtyp) = E_Anonymous_Access_Type then
- Etyp := Directly_Designated_Type (Rtyp);
-
- if Is_Class_Wide_Type (Etyp)
- and then From_Limited_With (Etyp)
- then
- Set_Directly_Designated_Type
- (Etype (Current_Scope), Available_View (Etyp));
- end if;
- end if;
- end;
- end if;
-
-- If this is the proper body of a stub, we must verify that the stub
-- conforms to the body, and to the previous spec if one was present.
-- We know already that the body conforms to that spec. This test is
@@ -3918,10 +3891,35 @@ package body Sem_Ch6 is
-- of a subprogram body may use the parameter and result profile of the
-- spec, swap any limited views with their non-limited counterpart.
- if Ada_Version >= Ada_2012 then
+ if Ada_Version >= Ada_2012 and then Present (Spec_Id) then
Exch_Views := Exchange_Limited_Views (Spec_Id);
end if;
+ -- If the return type is an anonymous access type whose designated type
+ -- is the limited view of a class-wide type and the non-limited view is
+ -- available, update the return type accordingly.
+
+ if Ada_Version >= Ada_2005 and then Present (Spec_Id) then
+ declare
+ Etyp : Entity_Id;
+ Rtyp : Entity_Id;
+
+ begin
+ Rtyp := Etype (Spec_Id);
+
+ if Ekind (Rtyp) = E_Anonymous_Access_Type then
+ Etyp := Directly_Designated_Type (Rtyp);
+
+ if Is_Class_Wide_Type (Etyp)
+ and then From_Limited_With (Etyp)
+ then
+ Desig_View := Etyp;
+ Set_Directly_Designated_Type (Rtyp, Available_View (Etyp));
+ end if;
+ end if;
+ end;
+ end if;
+
-- Analyze any aspect specifications that appear on the subprogram body
if Has_Aspects (N) then
@@ -4191,6 +4189,10 @@ package body Sem_Ch6 is
Restore_Limited_Views (Exch_Views);
end if;
+ if Present (Desig_View) then
+ Set_Directly_Designated_Type (Etype (Spec_Id), Desig_View);
+ end if;
+
Ghost_Mode := Save_Ghost_Mode;
end Analyze_Subprogram_Body_Helper;
