From 128a98eacef4f47310de212932389f740acfa881 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Mon, 6 Jun 2016 08:46:33 +0000 Subject: [PATCH] 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 --- gcc/ada/ChangeLog | 23 ++++++++++++++++ gcc/ada/exp_ch9.adb | 13 ++++++---- gcc/ada/sem_ch13.adb | 6 +---- gcc/ada/sem_ch3.adb | 42 +++++++++++++++--------------- gcc/ada/sem_ch6.adb | 62 +++++++++++++++++++++++--------------------- 5 files changed, 85 insertions(+), 61 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 52b8f5454e1..12a2483b43d 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,26 @@ +2016-06-06 Eric Botcazou + + * 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 PR ada/71358 diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index dc167225bd9..d8ccafa6f40 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -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 diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 589c0a1a2f6..06e5d1b66e5 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -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); diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index f3c8584e160..642b880c8c5 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -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)); diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index cd6a6d4fcac..a6ac2920076 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -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; -- 2.30.2