From c7cb99f885d2d6d520ef8ff0ff35e0158f2c6264 Mon Sep 17 00:00:00 2001 From: Piotr Trojanek Date: Mon, 16 Mar 2020 21:29:27 +0100 Subject: [PATCH] [Ada] Remove a dubious optimization for Object Specific Data dispatching 2020-06-11 Piotr Trojanek 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 | 3 ++ gcc/ada/exp_disp.adb | 2 +- gcc/ada/sem_aggr.adb | 68 -------------------------------------------- 3 files changed, 4 insertions(+), 69 deletions(-) diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index b608346d6fd..ced0d70629d 100644 --- a/gcc/ada/exp_aggr.adb +++ b/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 diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index 617cb1be7bd..b8cbd4a2275 100644 --- a/gcc/ada/exp_disp.adb +++ b/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, diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index a3ac7caf6f7..505ddfe2d59 100644 --- a/gcc/ada/sem_aggr.adb +++ b/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 -- 2.30.2