aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorPiotr Trojanek <trojanek@adacore.com>2020-03-16 21:29:27 +0100
committerPierre-Marie de Rodat <derodat@adacore.com>2020-06-11 05:53:41 -0400
commitc7cb99f885d2d6d520ef8ff0ff35e0158f2c6264 (patch)
treec9230d289d80f53d984c534514408fbf1e6760e2 /gcc
parent6dc5653584ca84f7d396dd2aa8b65070a1c1f7e1 (diff)
downloadgcc-c7cb99f885d2d6d520ef8ff0ff35e0158f2c6264.zip
gcc-c7cb99f885d2d6d520ef8ff0ff35e0158f2c6264.tar.gz
gcc-c7cb99f885d2d6d520ef8ff0ff35e0158f2c6264.tar.bz2
[Ada] Remove a dubious optimization for Object Specific Data dispatching
2020-06-11 Piotr Trojanek <trojanek@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.
Diffstat (limited to 'gcc')
-rw-r--r--gcc/ada/exp_aggr.adb3
-rw-r--r--gcc/ada/exp_disp.adb2
-rw-r--r--gcc/ada/sem_aggr.adb68
3 files changed, 4 insertions, 69 deletions
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index b608346..ced0d70 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 617cb1b..b8cbd4a 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 a3ac7ca..505ddfe 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