Routines Sem_Aggr.Build_Constrained_Itype and Sem_Ch3.Build_Subtype that
create discriminated itypes were originally identical, but now they are
subtly different. This patch removes one of their two subtle
differences, namely a call to Set_Size_Known_At_Compile_Time that was
meant as a very narrow optimization (and was introduced many years ago
without a specific reason).
This call appears to only matter for aggregates of the
Ada.Tags.Object_Specific_Data type, which are part of the secondary
dispatch table machinery. Now, instead of relying on this very specific
optimization we recognize aggregates of this type as static. This is
safe, because such aggregates are only created in the Exp_Disp.Make_DT
routine and are only composed from integer literals.
Tested on x86_64-pc-linux-gnu, committed on trunk
2020-06-11 Piotr Trojanek <troja...@adacore.com>
gcc/ada/
* exp_disp.adb: Minor reformatting.
* exp_aggr.adb (Is_Static_Dispatch_Table_Aggregate): Recognize
aggregates of the Ada.Tags.Object_Specific_Data type as static.
* sem_aggr.adb (Check_Static_Discriminated_Subtype): Deconstruct
and do not call it from Build_Constrained_Itype.--- gcc/ada/exp_aggr.adb
+++ gcc/ada/exp_aggr.adb
@@ -7790,6 +7790,9 @@ package body Exp_Aggr is
or else
Typ = RTE (RE_Tag_Table)
or else
+ (RTE_Available (RE_Object_Specific_Data)
+ and then Typ = RTE (RE_Object_Specific_Data))
+ or else
(RTE_Available (RE_Interface_Data)
and then Typ = RTE (RE_Interface_Data))
or else
--- gcc/ada/exp_disp.adb
+++ gcc/ada/exp_disp.adb
@@ -4348,7 +4348,7 @@ package body Exp_Disp is
Attribute_Name => Name_Alignment)));
-- In secondary dispatch tables the Typeinfo component contains
- -- the address of the Object Specific Data (see a-tags.ads)
+ -- the address of the Object Specific Data (see a-tags.ads).
Append_To (DT_Aggr_List,
Make_Attribute_Reference (Loc,
--- gcc/ada/sem_aggr.adb
+++ gcc/ada/sem_aggr.adb
@@ -226,12 +226,6 @@ package body Sem_Aggr is
-- misspelling of one of the components of the Assoc_List. This is called
-- by Resolve_Aggr_Expr after producing an invalid component error message.
- procedure Check_Static_Discriminated_Subtype (T : Entity_Id; V : Node_Id);
- -- An optimization: determine whether a discriminated subtype has a static
- -- constraint, and contains array components whose length is also static,
- -- either because they are constrained by the discriminant, or because the
- -- original component bounds are static.
-
-----------------------------------------------------
-- Subprograms used for ARRAY AGGREGATE Processing --
-----------------------------------------------------
@@ -722,66 +716,6 @@ package body Sem_Aggr is
end if;
end Check_Expr_OK_In_Limited_Aggregate;
- ----------------------------------------
- -- Check_Static_Discriminated_Subtype --
- ----------------------------------------
-
- procedure Check_Static_Discriminated_Subtype (T : Entity_Id; V : Node_Id) is
- Disc : constant Entity_Id := First_Discriminant (T);
- Comp : Entity_Id;
- Ind : Entity_Id;
-
- begin
- if Has_Record_Rep_Clause (T) then
- return;
-
- elsif Present (Next_Discriminant (Disc)) then
- return;
-
- elsif Nkind (V) /= N_Integer_Literal then
- return;
- end if;
-
- Comp := First_Component (T);
- while Present (Comp) loop
- if Is_Scalar_Type (Etype (Comp)) then
- null;
-
- elsif Is_Private_Type (Etype (Comp))
- and then Present (Full_View (Etype (Comp)))
- and then Is_Scalar_Type (Full_View (Etype (Comp)))
- then
- null;
-
- elsif Is_Array_Type (Etype (Comp)) then
- if Is_Bit_Packed_Array (Etype (Comp)) then
- return;
- end if;
-
- Ind := First_Index (Etype (Comp));
- while Present (Ind) loop
- if Nkind (Ind) /= N_Range
- or else Nkind (Low_Bound (Ind)) /= N_Integer_Literal
- or else Nkind (High_Bound (Ind)) /= N_Integer_Literal
- then
- return;
- end if;
-
- Next_Index (Ind);
- end loop;
-
- else
- return;
- end if;
-
- Next_Component (Comp);
- end loop;
-
- -- On exit, all components have statically known sizes
-
- Set_Size_Known_At_Compile_Time (T);
- end Check_Static_Discriminated_Subtype;
-
-------------------------
-- Is_Others_Aggregate --
-------------------------
@@ -4509,8 +4443,6 @@ package body Sem_Aggr is
Analyze (Subtyp_Decl, Suppress => All_Checks);
Set_Etype (N, Def_Id);
- Check_Static_Discriminated_Subtype
- (Def_Id, Expression (First (New_Assoc_List)));
end Build_Constrained_Itype;
else
