From: Piotr Trojanek <trojanek@adacore.com>
Date: Mon, 16 Mar 2020 20:29:27 +0000 (+0100)
Subject: [Ada] Remove a dubious optimization for Object Specific Data dispatching
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=c7cb99f885d2d6d520ef8ff0ff35e0158f2c6264;p=gcc.git

[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.
---

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