[Ada] Do not freeze profiles for dispatch tables

When static dispatch tables are built for library-level tagged types, the
primitives (the subprogram themselves) are frozen; that's necessary because
their address is taken.  However, their profile, i.e. all the types present
therein, is also frozen, which is not necessary after AI05-019 and is also
inconsistent with the handling of attribute references.

The change also removes a couple of pragma Inline on subprograms that are
too large for inlining to bring any benefit.

gcc/ada/

	* exp_ch3.adb (Expand_N_Object_Declaration): Adjust call to Make_DT.
	* exp_disp.ads (Building_Static_DT): Remove pragma Inline.
	(Building_Static_Secondary_DT): Likewise.
	(Convert_Tag_To_Interface): Likewise.
	(Make_DT): Remove second parameter.
	* exp_disp.adb (Make_DT): Likewise.
	(Check_Premature_Freezing): Delete.
	Pass Do_Freeze_Profile as False in call to Freeze_Entity.
	* freeze.ads (Freezing_Library_Level_Tagged_Type): Delete.
	* freeze.adb (Freeze_Profile): Remove obsolete code.
	(Freeze_Entity): Tweak comment.

5 files changed, 19 insertions, 181 deletions

diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 4216fecc438..87a84b4d858 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -6909,9 +6909,9 @@ package body Exp_Ch3 is
 
          begin
             if Is_Concurrent_Type (Base_Typ) then
-               New_Nodes := Make_DT (Corresponding_Record_Type (Base_Typ), N);
+               New_Nodes := Make_DT (Corresponding_Record_Type (Base_Typ));
             else
-               New_Nodes := Make_DT (Base_Typ, N);
+               New_Nodes := Make_DT (Base_Typ);
             end if;
 
             Insert_List_Before (N, New_Nodes);
diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb
index e9967b4ac99..a0a34496541 100644
--- a/gcc/ada/exp_disp.adb
+++ b/gcc/ada/exp_disp.adb
@@ -3660,7 +3660,7 @@ package body Exp_Disp is
    --  replaced by gotos which jump to the end of the routine and restore the
    --  Ghost mode.
 
-   function Make_DT (Typ : Entity_Id; N : Node_Id := Empty) return List_Id is
+   function Make_DT (Typ : Entity_Id) return List_Id is
       Loc : constant Source_Ptr := Sloc (Typ);
 
       Max_Predef_Prims : constant Int :=
@@ -3678,23 +3678,6 @@ package body Exp_Disp is
       --  offset to the components that reference secondary dispatch tables.
       --  Used to compute the offset of components located at fixed position.
 
-      procedure Check_Premature_Freezing
-        (Subp        : Entity_Id;
-         Tagged_Type : Entity_Id;
-         Typ         : Entity_Id);
-      --  Verify that all untagged types in the profile of a subprogram are
-      --  frozen at the point the subprogram is frozen. This enforces the rule
-      --  on RM 13.14 (14) as modified by AI05-019. At the point a subprogram
-      --  is frozen, enough must be known about it to build the activation
-      --  record for it, which requires at least that the size of all
-      --  parameters be known. Controlling arguments are by-reference,
-      --  and therefore the rule only applies to untagged types. Typical
-      --  violation of the rule involves an object declaration that freezes a
-      --  tagged type, when one of its primitive operations has a type in its
-      --  profile whose full view has not been analyzed yet. More complex cases
-      --  involve composite types that have one private unfrozen subcomponent.
-      --  Move this check to sem???
-
       procedure Export_DT (Typ : Entity_Id; DT : Entity_Id; Index : Nat := 0);
       --  Export the dispatch table DT of tagged type Typ. Required to generate
       --  forward references and statically allocate the table. For primary
@@ -3733,103 +3716,6 @@ package body Exp_Disp is
       function Number_Of_Predefined_Prims (Typ : Entity_Id) return Nat;
       --  Returns the number of predefined primitives of Typ
 
-      ------------------------------
-      -- Check_Premature_Freezing --
-      ------------------------------
-
-      procedure Check_Premature_Freezing
-        (Subp        : Entity_Id;
-         Tagged_Type : Entity_Id;
-         Typ         : Entity_Id)
-      is
-         Comp : Entity_Id;
-
-         function Is_Actual_For_Formal_Incomplete_Type
-           (T : Entity_Id) return Boolean;
-         --  In Ada 2012, if a nested generic has an incomplete formal type,
-         --  the actual may be (and usually is) a private type whose completion
-         --  appears later. It is safe to build the dispatch table in this
-         --  case, gigi will have full views available.
-
-         ------------------------------------------
-         -- Is_Actual_For_Formal_Incomplete_Type --
-         ------------------------------------------
-
-         function Is_Actual_For_Formal_Incomplete_Type
-           (T : Entity_Id) return Boolean
-         is
-            Gen_Par : Entity_Id;
-            F       : Node_Id;
-
-         begin
-            if not Is_Generic_Instance (Current_Scope)
-              or else not Used_As_Generic_Actual (T)
-            then
-               return False;
-            else
-               Gen_Par := Generic_Parent (Parent (Current_Scope));
-            end if;
-
-            F :=
-              First
-                (Generic_Formal_Declarations
-                   (Unit_Declaration_Node (Gen_Par)));
-            while Present (F) loop
-               if Ekind (Defining_Identifier (F)) = E_Incomplete_Type then
-                  return True;
-               end if;
-
-               Next (F);
-            end loop;
-
-            return False;
-         end Is_Actual_For_Formal_Incomplete_Type;
-
-      --  Start of processing for Check_Premature_Freezing
-
-      begin
-         --  Note that if the type is a (subtype of) a generic actual, the
-         --  actual will have been frozen by the instantiation.
-
-         if Present (N)
-           and then Is_Private_Type (Typ)
-           and then No (Full_View (Typ))
-           and then not Has_Private_Declaration (Typ)
-           and then not Is_Generic_Type (Typ)
-           and then not Is_Tagged_Type (Typ)
-           and then not Is_Frozen (Typ)
-           and then not Is_Generic_Actual_Type (Typ)
-         then
-            Error_Msg_Sloc := Sloc (Subp);
-            Error_Msg_NE
-              ("declaration must appear after completion of type &", N, Typ);
-            Error_Msg_NE
-              ("\which is an untagged type in the profile of "
-               & "primitive operation & declared#", N, Subp);
-
-         else
-            Comp := Private_Component (Typ);
-
-            if not Is_Tagged_Type (Typ)
-              and then Present (Comp)
-              and then not Is_Frozen (Comp)
-              and then not Has_Private_Declaration (Comp)
-              and then not Is_Actual_For_Formal_Incomplete_Type (Comp)
-            then
-               Error_Msg_Sloc := Sloc (Subp);
-               Error_Msg_NE
-                 ("declaration must appear after completion of type &",
-                  N, Comp);
-               Error_Msg_Node_2 := Subp;
-               Error_Msg_Name_1 := Chars (Tagged_Type);
-               Error_Msg_NE
-                 ("\which is a component of untagged type& in the profile "
-                  & "of primitive & of type % that is frozen by the "
-                  & "declaration", N, Typ);
-            end if;
-         end if;
-      end Check_Premature_Freezing;
-
       ---------------
       -- Export_DT --
       ---------------
@@ -4584,55 +4470,31 @@ package body Exp_Disp is
       end if;
 
       --  Ensure that all the primitives are frozen. This is only required when
-      --  building static dispatch tables --- the primitives must be frozen to
-      --  be referenced (otherwise we have problems with the backend). It is
+      --  building static dispatch tables: the primitives must be frozen to be
+      --  referenced, otherwise we have problems with the back end. But this is
       --  not a requirement with nonstatic dispatch tables because in this case
-      --  we generate now an empty dispatch table; the extra code required to
-      --  register the primitives in the slots will be generated later --- when
-      --  each primitive is frozen (see Freeze_Subprogram).
+      --  we generate an empty dispatch table at this point and the extra code
+      --  required to register the primitives in their slot will be generated
+      --  later, when each primitive is frozen (see Freeze_Subprogram).
 
       if Building_Static_DT (Typ) then
          declare
-            Saved_FLLTT : constant Boolean :=
-                            Freezing_Library_Level_Tagged_Type;
-
-            Formal    : Entity_Id;
-            Frnodes   : List_Id;
+            F_List    : List_Id;
             Prim      : Entity_Id;
             Prim_Elmt : Elmt_Id;
 
          begin
-            Freezing_Library_Level_Tagged_Type := True;
-
             Prim_Elmt := First_Elmt (Primitive_Operations (Typ));
             while Present (Prim_Elmt) loop
-               Prim    := Node (Prim_Elmt);
-               Frnodes := Freeze_Entity (Prim, Typ);
-
-               --  We disable this check for abstract subprograms, given that
-               --  they cannot be called directly and thus the state of their
-               --  untagged formals is of no concern. The RM is unclear in any
-               --  case concerning the need for this check, and this topic may
-               --  go back to the ARG.
-
-               if not Is_Abstract_Subprogram (Prim) then
-                  Formal := First_Formal (Prim);
-                  while Present (Formal) loop
-                     Check_Premature_Freezing (Prim, Typ, Etype (Formal));
-                     Next_Formal (Formal);
-                  end loop;
-
-                  Check_Premature_Freezing (Prim, Typ, Etype (Prim));
-               end if;
+               Prim   := Node (Prim_Elmt);
+               F_List := Freeze_Entity (Prim, Typ, Do_Freeze_Profile => False);
 
-               if Present (Frnodes) then
-                  Append_List_To (Result, Frnodes);
+               if Present (F_List) then
+                  Append_List_To (Result, F_List);
                end if;
 
                Next_Elmt (Prim_Elmt);
             end loop;
-
-            Freezing_Library_Level_Tagged_Type := Saved_FLLTT;
          end;
       end if;
 
diff --git a/gcc/ada/exp_disp.ads b/gcc/ada/exp_disp.ads
index cbb5ba606a3..96eae30e0a9 100644
--- a/gcc/ada/exp_disp.ads
+++ b/gcc/ada/exp_disp.ads
@@ -168,11 +168,9 @@ package Exp_Disp is
    --  Generate checks required on dispatching calls
 
    function Building_Static_DT (Typ : Entity_Id) return Boolean;
-   pragma Inline (Building_Static_DT);
    --  Returns true when building statically allocated dispatch tables
 
    function Building_Static_Secondary_DT (Typ : Entity_Id) return Boolean;
-   pragma Inline (Building_Static_Secondary_DT);
    --  Returns true when building statically allocated secondary dispatch
    --  tables
 
@@ -187,7 +185,6 @@ package Exp_Disp is
 
    function Convert_Tag_To_Interface
      (Typ : Entity_Id; Expr : Node_Id) return Node_Id;
-   pragma Inline (Convert_Tag_To_Interface);
    --  This function is used in class-wide interface conversions; the expanded
    --  code generated to convert a tagged object to a class-wide interface type
    --  involves referencing the tag component containing the secondary dispatch
@@ -256,11 +253,8 @@ package Exp_Disp is
    function Is_Expanded_Dispatching_Call (N : Node_Id) return Boolean;
    --  Returns true if N is the expanded code of a dispatching call
 
-   function Make_DT (Typ : Entity_Id; N : Node_Id := Empty) return List_Id;
-   --  Expand the declarations for the Dispatch Table. The node N is the
-   --  declaration that forces the generation of the table. It is used to place
-   --  error messages when the declaration leads to the freezing of a given
-   --  primitive operation that has an incomplete non- tagged formal.
+   function Make_DT (Typ : Entity_Id) return List_Id;
+   --  Expand the declarations for the Dispatch Table of Typ
 
    function Make_Disp_Asynchronous_Select_Body
      (Typ : Entity_Id) return Node_Id;
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 4ff70367014..0301bf43b15 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -4631,9 +4631,7 @@ package body Freeze is
                   Result := No_List;
                   return False;
 
-               elsif not After_Last_Declaration
-                 and then not Freezing_Library_Level_Tagged_Type
-               then
+               elsif not After_Last_Declaration then
                   Error_Msg_NE
                     ("type & must be fully defined before this point",
                      N,
@@ -4751,17 +4749,6 @@ package body Freeze is
                if Is_Access_Type (F_Type) then
                   F_Type := Designated_Type (F_Type);
                end if;
-
-               --  If the formal is an anonymous_access_to_subprogram
-               --  freeze the  subprogram type as well, to prevent
-               --  scope anomalies in gigi, because there is no other
-               --  clear point at which it could be frozen.
-
-               if Is_Itype (Etype (Formal))
-                 and then Ekind (F_Type) = E_Subprogram_Type
-               then
-                  Freeze_And_Append (F_Type, N, Result);
-               end if;
             end if;
 
             Next_Formal (Formal);
@@ -6490,9 +6477,10 @@ package body Freeze is
 
             --  In Ada 2012, freezing a subprogram does not always freeze the
             --  corresponding profile (see AI05-019). An attribute reference
-            --  is not a freezing point of the profile. Flag Do_Freeze_Profile
+            --  is not a freezing point of the profile. Similarly, we do not
+            --  freeze the profile of primitives of a library-level tagged type
+            --  when we are building its dispatch table. Flag Do_Freeze_Profile
             --  indicates whether the profile should be frozen now.
-            --  Other constructs that should not freeze ???
 
             --  This processing doesn't apply to internal entities (see below)
 
diff --git a/gcc/ada/freeze.ads b/gcc/ada/freeze.ads
index 749fb79803b..bef4e14474b 100644
--- a/gcc/ada/freeze.ads
+++ b/gcc/ada/freeze.ads
@@ -120,12 +120,6 @@ package Freeze is
    --  where the freeze node is preallocated at the point of declaration, so
    --  that the First_Subtype_Link field can be set.
 
-   Freezing_Library_Level_Tagged_Type : Boolean := False;
-   --  Flag used to indicate that we are freezing the primitives of a library
-   --  level tagged type. Used to disable checks on premature freezing.
-   --  More documentation needed??? why is this flag needed? what are these
-   --  checks? why do they need disabling in some cases?
-
    -----------------
    -- Subprograms --
    -----------------