+2016-06-06 Eric Botcazou <ebotcazou@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.
+
2016-06-01 Simon Wright <simon@pushface.org>
PR ada/71358
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
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;
pragma Assert (Present (Pdef));
+ Insert_After (Current_Node, Rec_Decl);
+ Current_Node := Rec_Decl;
+
-- Add private field components
if Present (Private_Declarations (Pdef)) then
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
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);
-- 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.
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;
--------------------------------
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);
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
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));
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;
-- 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;
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
-- 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
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;
projects / gcc.git / commitdiff