OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

exp_ch9.adb (Expand_N_Protected_Type_Declaration): Insert the declaration of the corresponding record type before that of the... 

* 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.

From-SVN: r237118
This commit is contained in:
Eric Botcazou 2016-06-06 08:46:33 +00:00 committed by Eric Botcazou
parent 9fcebb5aa8
commit 128a98eace
5 changed files with 85 additions and 61 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
gcc/ada/ChangeLog
View File

@ -1,3 +1,26 @@
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

13
gcc/ada/exp_ch9.adb
View File

@ -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

6
gcc/ada/sem_ch13.adb
View File

@ -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);

42
gcc/ada/sem_ch3.adb
View File

@ -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));

62
gcc/ada/sem_ch6.adb
View File

@ -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;