[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 b608346d6fda50241e328bcbbd85343c5b367f45..ced0d70629df77c3587d2f6867797a377118ef21 100644 (file)
--- 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 617cb1be7bd1b79159551195fc893d649a4e7c5e..b8cbd4a227500bc769ff6a0c4945a3dbc2479452 100644 (file)
--- 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 a3ac7caf6f75360f5ac55c8043bc2ad38c7fb478..505ddfe2d5985ea767f0be17146aca0e283deb05 100644 (file)
--- 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