From: Hristian Kirtchev Date: Fri, 22 May 2015 12:34:33 +0000 (+0000) Subject: einfo.adb (Default_Init_Cond_Procedure): Code cleanup. X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=caef4e579db9d9ab0cc7eba35e58b04e4ac65649;p=gcc.git einfo.adb (Default_Init_Cond_Procedure): Code cleanup. 2015-05-22 Hristian Kirtchev * einfo.adb (Default_Init_Cond_Procedure): Code cleanup. The attribute now applies to the base type. (Has_Default_Init_Cond): Now applies to the base type. (Has_Inherited_Default_Init_Cond): Now applies to the base type. (Set_Default_Init_Cond_Procedure): Code cleanup. The attribute now applies to the base type. (Set_Has_Default_Init_Cond): Now applies to the base type. (Set_Has_Inherited_Default_Init_Cond): Now applies to the base type. * exp_ch3.adb (Expand_N_Object_Declaration): No need to use the base type when adding a call to the Default_Initial_Condition. From-SVN: r223551 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index e9160b3d9d4..87519d850c2 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,6 +1,19 @@ 2015-05-22 Hristian Kirtchev - * einfo.adb Node36 is now used as Anonymous_Master. Flag253 + * einfo.adb (Default_Init_Cond_Procedure): Code cleanup. The + attribute now applies to the base type. + (Has_Default_Init_Cond): Now applies to the base type. + (Has_Inherited_Default_Init_Cond): Now applies to the base type. + (Set_Default_Init_Cond_Procedure): Code cleanup. The attribute now + applies to the base type. + (Set_Has_Default_Init_Cond): Now applies to the base type. + (Set_Has_Inherited_Default_Init_Cond): Now applies to the base type. + * exp_ch3.adb (Expand_N_Object_Declaration): No need to use the + base type when adding a call to the Default_Initial_Condition. + +2015-05-22 Hristian Kirtchev + + * einfo.adb: Node36 is now used as Anonymous_Master. Flag253 is now unused. (Anonymous_Master): New routine. (Has_Anonymous_Master): Removed. diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index 1d8f4f43425..ce0eb4a63be 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -1448,7 +1448,8 @@ package body Einfo is function Has_Default_Init_Cond (Id : E) return B is begin - return Flag3 (Id); + pragma Assert (Is_Type (Id)); + return Flag3 (Base_Type (Id)); end Has_Default_Init_Cond; function Has_Delayed_Aspects (Id : E) return B is @@ -1543,7 +1544,7 @@ package body Einfo is function Has_Inherited_Default_Init_Cond (Id : E) return B is begin pragma Assert (Is_Type (Id)); - return Flag133 (Id); + return Flag133 (Base_Type (Id)); end Has_Inherited_Default_Init_Cond; function Has_Initial_Value (Id : E) return B is @@ -4326,7 +4327,7 @@ package body Einfo is procedure Set_Has_Default_Init_Cond (Id : E; V : B := True) is begin pragma Assert (Is_Type (Id)); - Set_Flag3 (Id, V); + Set_Flag3 (Base_Type (Id), V); end Set_Has_Default_Init_Cond; procedure Set_Has_Delayed_Aspects (Id : E; V : B := True) is @@ -4426,7 +4427,7 @@ package body Einfo is procedure Set_Has_Inherited_Default_Init_Cond (Id : E; V : B := True) is begin pragma Assert (Is_Type (Id)); - Set_Flag133 (Id, V); + Set_Flag133 (Base_Type (Id), V); end Set_Has_Inherited_Default_Init_Cond; procedure Set_Has_Initial_Value (Id : E; V : B := True) is @@ -6727,21 +6728,21 @@ package body Einfo is --------------------------------- function Default_Init_Cond_Procedure (Id : E) return E is - S : Entity_Id; + Subp_Id : Entity_Id; begin pragma Assert (Is_Type (Id) - and then (Has_Default_Init_Cond (Id) - or Has_Inherited_Default_Init_Cond (Id))); + and then (Has_Default_Init_Cond (Id) + or Has_Inherited_Default_Init_Cond (Id))); - S := Subprograms_For_Type (Id); - while Present (S) loop - if Is_Default_Init_Cond_Procedure (S) then - return S; + Subp_Id := Subprograms_For_Type (Base_Type (Id)); + while Present (Subp_Id) loop + if Is_Default_Init_Cond_Procedure (Subp_Id) then + return Subp_Id; end if; - S := Subprograms_For_Type (S); + Subp_Id := Subprograms_For_Type (Subp_Id); end loop; return Empty; @@ -8282,26 +8283,28 @@ package body Einfo is ------------------------------------- procedure Set_Default_Init_Cond_Procedure (Id : E; V : E) is - S : Entity_Id; + Base_Typ : Entity_Id; + Subp_Id : Entity_Id; begin pragma Assert - (Is_Type (Id) and then (Has_Default_Init_Cond (Id) - or - Has_Inherited_Default_Init_Cond (Id))); + (Is_Type (Id) + and then (Has_Default_Init_Cond (Id) + or Has_Inherited_Default_Init_Cond (Id))); + Base_Typ := Base_Type (Id); - S := Subprograms_For_Type (Id); - Set_Subprograms_For_Type (Id, V); - Set_Subprograms_For_Type (V, S); + Subp_Id := Subprograms_For_Type (Base_Typ); + Set_Subprograms_For_Type (Base_Typ, V); + Set_Subprograms_For_Type (V, Subp_Id); -- Check for a duplicate procedure - while Present (S) loop - if Is_Default_Init_Cond_Procedure (S) then + while Present (Subp_Id) loop + if Is_Default_Init_Cond_Procedure (Subp_Id) then raise Program_Error; end if; - S := Subprograms_For_Type (S); + Subp_Id := Subprograms_For_Type (Subp_Id); end loop; end Set_Default_Init_Cond_Procedure; diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 0baa3f68edc..6223c970fca 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -6147,14 +6147,14 @@ package body Exp_Ch3 is -- Note that the check is generated for source objects only if Comes_From_Source (Def_Id) - and then (Has_Default_Init_Cond (Base_Typ) + and then (Has_Default_Init_Cond (Typ) or else - Has_Inherited_Default_Init_Cond (Base_Typ)) + Has_Inherited_Default_Init_Cond (Typ)) and then not Has_Init_Expression (N) then declare DIC_Call : constant Node_Id := - Build_Default_Init_Cond_Call (Loc, Def_Id, Base_Typ); + Build_Default_Init_Cond_Call (Loc, Def_Id, Typ); begin if Present (Next_N) then Insert_Before_And_Analyze (Next_N, DIC_Call);