* [Ada] Reuse Has_Defaulted_Discriminants where possible
@ 2021-05-05 8:20 Pierre-Marie de Rodat
0 siblings, 0 replies; only message in thread
From: Pierre-Marie de Rodat @ 2021-05-05 8:20 UTC (permalink / raw)
To: gcc-patches; +Cc: Piotr Trojanek
[-- Attachment #1: Type: text/plain, Size: 646 bytes --]
Remove excessive defensive check from Has_Defaulted_Discriminants and
reuse it where possible. Cleanup only; semantics is unaffected.
Tested on x86_64-pc-linux-gnu, committed on trunk
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.
[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 5706 bytes --]
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
--- 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
--- 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
--- 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
--- 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
--- 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;
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2021-05-05 8:20 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-05-05 8:20 [Ada] Reuse Has_Defaulted_Discriminants where possible Pierre-Marie de Rodat
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).