From 8adc8d9b7c61f4ed9e349ebe9c091ce45e6978e4 Mon Sep 17 00:00:00 2001 From: Piotr Trojanek Date: Thu, 14 Jan 2021 21:14:06 +0100 Subject: [PATCH] [Ada] Reuse Has_Defaulted_Discriminants where possible gcc/ada/ * exp_attr.adb, exp_ch9.adb, sem_ch3.adb: Reuse Has_Defaulted_Discriminants. * sem_ch4.adb (Analyze_Allocator): Reuse Has_Defaulted_Discriminants (after reordering conjuncts); remove redundant IF statement, whose condition is implied by Has_Defaulted_Discriminants. * sem_util.adb (Has_Defaulted_Discriminants): Has_Discriminants implies that the First_Discriminant is present. (Is_Fully_Initialized_Type): Reuse Has_Defaulted_Discriminants. --- gcc/ada/exp_attr.adb | 10 ++-------- gcc/ada/exp_ch9.adb | 4 +--- gcc/ada/sem_ch3.adb | 8 ++------ gcc/ada/sem_ch4.adb | 28 +++++++++++----------------- gcc/ada/sem_util.adb | 5 +---- 5 files changed, 17 insertions(+), 38 deletions(-) diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index c5c6b6d..6c8abed 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -6115,10 +6115,7 @@ package body Exp_Attr is return; end if; - if Has_Discriminants (U_Type) - and then Present - (Discriminant_Default_Value (First_Discriminant (U_Type))) - then + if Has_Defaulted_Discriminants (U_Type) then Build_Mutable_Record_Read_Procedure (Loc, Full_Base (U_Type), Decl, Pname); else @@ -7750,10 +7747,7 @@ package body Exp_Attr is end if; end if; - if Has_Discriminants (U_Type) - and then Present - (Discriminant_Default_Value (First_Discriminant (U_Type))) - then + if Has_Defaulted_Discriminants (U_Type) then Build_Mutable_Record_Write_Procedure (Loc, Full_Base (U_Type), Decl, Pname); else diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index 9be6c20..825bf20 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -13972,9 +13972,7 @@ package body Exp_Ch9 is begin return Scope (Base_Index) = Standard_Standard and then Base_Index = Base_Type (Standard_Integer) - and then Has_Discriminants (Conctyp) - and then - Present (Discriminant_Default_Value (First_Discriminant (Conctyp))) + and then Has_Defaulted_Discriminants (Conctyp) and then (Denotes_Discriminant (Lo, True) or else diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index d312a01..d4cd8d7 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -13971,9 +13971,7 @@ package body Sem_Ch3 is (Has_Unknown_Discriminants (T) or else (not Has_Discriminants (T) - and then Has_Discriminants (Full_View (T)) - and then Present (Discriminant_Default_Value - (First_Discriminant (Full_View (T)))))) + and then Has_Defaulted_Discriminants (Full_View (T)))) then T := Full_View (T); E := Full_View (E); @@ -20805,9 +20803,7 @@ package body Sem_Ch3 is if not Has_Unknown_Discriminants (Priv_T) and then not Has_Discriminants (Priv_T) - and then Has_Discriminants (Full_T) - and then - Present (Discriminant_Default_Value (First_Discriminant (Full_T))) + and then Has_Defaulted_Discriminants (Full_T) then Set_Has_Constrained_Partial_View (Full_T); Set_Has_Constrained_Partial_View (Priv_T); diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 85e63e9..59ce28e 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -599,12 +599,8 @@ package body Sem_Ch4 is Type_Id := Entity (E); if Is_Tagged_Type (Type_Id) - and then Has_Discriminants (Type_Id) + and then Has_Defaulted_Discriminants (Type_Id) and then not Is_Constrained (Type_Id) - and then - Present - (Discriminant_Default_Value - (First_Discriminant (Type_Id))) then declare Constr : constant List_Id := New_List; @@ -612,19 +608,17 @@ package body Sem_Ch4 is Discr : Entity_Id := First_Discriminant (Type_Id); begin - if Present (Discriminant_Default_Value (Discr)) then - while Present (Discr) loop - Append (Discriminant_Default_Value (Discr), Constr); - Next_Discriminant (Discr); - end loop; + while Present (Discr) loop + Append (Discriminant_Default_Value (Discr), Constr); + Next_Discriminant (Discr); + end loop; - Rewrite (E, - Make_Subtype_Indication (Loc, - Subtype_Mark => New_Occurrence_Of (Type_Id, Loc), - Constraint => - Make_Index_Or_Discriminant_Constraint (Loc, - Constraints => Constr))); - end if; + Rewrite (E, + Make_Subtype_Indication (Loc, + Subtype_Mark => New_Occurrence_Of (Type_Id, Loc), + Constraint => + Make_Index_Or_Discriminant_Constraint (Loc, + Constraints => Constr))); end; end if; end if; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index e64c545..86dd95b 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -11818,7 +11818,6 @@ package body Sem_Util is function Has_Defaulted_Discriminants (Typ : Entity_Id) return Boolean is begin return Has_Discriminants (Typ) - and then Present (First_Discriminant (Typ)) and then Present (Discriminant_Default_Value (First_Discriminant (Typ))); end Has_Defaulted_Discriminants; @@ -17141,9 +17140,7 @@ package body Sem_Util is -- Record types elsif Is_Record_Type (Typ) then - if Has_Discriminants (Typ) - and then - Present (Discriminant_Default_Value (First_Discriminant (Typ))) + if Has_Defaulted_Discriminants (Typ) and then Is_Fully_Initialized_Variant (Typ) then return True; -- 2.7.4