2005-03-08 Eric Botcazou <ebotcazou@adacore.com>

	    Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>
	    Nicolas Setton  <setton@adacore.com>
	    Ed Schonberg  <schonberg@adacore.com>

	PR ada/19900
	PR ada/19408
	PR ada/19140
	PR ada/20255

	* decl.c (gnat_to_gnu_field): Reject aliased components with a
	representation clause that prescribes a size not equal to the rounded
	size of their types.
	(gnat_to_gnu_entity, case E_Component): Always look at
	Original_Record_Component if Present and not the entity.
	(gnat_to_gnu_entity, case E_Record_Subtype): Rework handling of subtypes
	of tagged extension types by not making field for components that are
	inside the parent.
	(gnat_to_gnu_entity) <E_Record_Type>: Fix typo in the alignment formula
	(gnat_to_gnu_entity) <E_Variable>: Do not convert again the
	expression to the type of the object when the object is constant.
	Reverse defer_debug_incomplete_list before traversing it, so that trees
	are processed in the order at which they were added to the list. This
	order is important when using the stabs debug format.
	If we are deferring the output of debug information, also defer this
	output for a function return type.
	When adding fields to a record, prevent emitting debug information
	for incomplete records, emit the information only when the record is
	complete.
	(components_to_record): New parameter defer_debug.
	(gnat_to_gnu_entity, case E_Array_Subtype): Call copy_alias_set.
	(gnat_to_gnu_field_decl): New function.
	(substitution_list, annotate_rep): Call it.
	(gnat_to_gnu_entity, case E_Record_Subtype): Likewise.
	(gnat_to_gnu_entity, case E_Record_Type): Likewise.
	No longer update discriminants to not be a COMPONENT_REF.
	(copy_alias_set): Strip padding from input type; also handle
	unconstrained arrays properly.

	* gigi.h (write_record_type_debug_info): New function.
	Convert to use ANSI-style prototypes. Remove unused
	declarations for emit_stack_check, elab_all_gnat and
	set_second_error_entity.
	(gnat_to_gnu_field_decl): New decl.

	* utils.c (write_record_type_debug_info): New function.
	(finish_record_type): Delegate generation of debug information to
	write_record_type_debug_info.
	(update_pointer_to): Remove unneeded calls to rest_of_decl_compilation.
	(update_pointer_to): Fix pasto.
	(convert) <UNION_TYPE>: Accept slight type variations when
	converting to an unchecked union type.

	* exp_ch13.adb (Expand_N_Freeze_Entity): If Freeze_Type returns True,
	replace the N_Freeze_Entity with a null statement.

	* freeze.adb (Freeze_Expression): If the freeze nodes are generated
	within a constrained subcomponent of an enclosing record, place the
	freeze nodes in the scope stack entry for the enclosing record.
	(Undelay_Type): New Subprogram.
	(Set_Small_Size): Pass T, the type to modify; all callers changed.
	(Freeze_Entity, Freeze_Record_Type): Change the way we handle types
	within records; allow them to have freeze nodes if their base types
	aren't frozen yet.

	* sem_ch3.adb (Derived_Type_Declaration): New predicate
	Comes_From_Generic, to recognize accurately that the parent type in a
	derived type declaration can be traced back to a formal type, because
	it is one or is derived from one, or because its completion is derived
	from one.
	(Constrain_Component_Type): If component comes from source and has no
	explicit constraint, no need to constrain in in a subtype of the
	enclosing record.
	(Constrain_Access, Constrain_Array): Allow itypes to be delayed.
	Minor change to propagate Is_Ada_2005 flag

	* trans.c (gnat_to_gnu, case N_Aggregate): Verify that
	Expansion_Delayed is False.
	(assoc_to_constructor): Ignore fields that have a
	Corresponding_Discriminant.
	(gnat_to_gnu) <N_Return_Statement>: Restructure. If the
	function returns "by target", dereference the target pointer using the
	type of the actual return value.
	<all>: Be prepared for a null gnu_result.
	(processed_inline_subprograms): Check flag_really_no_inline
	instead of flag_no_inline.
	(set_second_error_entity): Remove unused function.
	(gnat_to_gnu, case N_Selected_Component): Call
	gnat_to_gnu_field_decl.
	(assoc_to_constructor): Likewise.


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@96492 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 250 insertions, 153 deletions

diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index e49ec85e4c6..0fe2173a093 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2004, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -164,6 +164,11 @@ package body Freeze is
    --  needed -- see body for details). Never has any effect on T if the
    --  Debug_Info_Off flag is set.
 
+   procedure Undelay_Type (T : Entity_Id);
+   --  T is a type of a component that we know to be an Itype.
+   --  We don't want this to have a Freeze_Node, so ensure it doesn't.
+   --  Do the same for any Full_View or Corresponding_Record_Type.
+
    procedure Warn_Overlay
      (Expr : Node_Id;
       Typ  : Entity_Id;
@@ -506,9 +511,9 @@ package body Freeze is
 
    procedure Check_Compile_Time_Size (T : Entity_Id) is
 
-      procedure Set_Small_Size (S : Uint);
+      procedure Set_Small_Size (T : Entity_Id; S : Uint);
       --  Sets the compile time known size (32 bits or less) in the Esize
-      --  field, checking for a size clause that was given which attempts
+      --  field, of T checking for a size clause that was given which attempts
       --  to give a smaller size.
 
       function Size_Known (T : Entity_Id) return Boolean;
@@ -525,7 +530,7 @@ package body Freeze is
       -- Set_Small_Size --
       --------------------
 
-      procedure Set_Small_Size (S : Uint) is
+      procedure Set_Small_Size (T : Entity_Id; S : Uint) is
       begin
          if S > 32 then
             return;
@@ -576,7 +581,8 @@ package body Freeze is
 
          elsif Is_Array_Type (T) then
             if Ekind (T) = E_String_Literal_Subtype then
-               Set_Small_Size (Component_Size (T) * String_Literal_Length (T));
+               Set_Small_Size (T, Component_Size (T)
+                               * String_Literal_Length (T));
                return True;
 
             elsif not Is_Constrained (T) then
@@ -632,7 +638,7 @@ package body Freeze is
                   Next_Index (Index);
                end loop;
 
-               Set_Small_Size (Esiz);
+               Set_Small_Size (T, Esiz);
                return True;
             end;
 
@@ -864,7 +870,7 @@ package body Freeze is
                end loop;
 
                if Packed_Size_Known then
-                  Set_Small_Size (Packed_Size);
+                  Set_Small_Size (T, Packed_Size);
                end if;
 
                return True;
@@ -1365,6 +1371,7 @@ package body Freeze is
    -------------------
 
    function Freeze_Entity (E : Entity_Id; Loc : Source_Ptr) return List_Id is
+      Test_E : Entity_Id := E;
       Comp   : Entity_Id;
       F_Node : Node_Id;
       Result : List_Id;
@@ -1460,6 +1467,7 @@ package body Freeze is
          IR   : Node_Id;
          Junk : Boolean;
          ADC  : Node_Id;
+         Prev : Entity_Id;
 
          Unplaced_Component : Boolean := False;
          --  Set True if we find at least one component with no component
@@ -1537,80 +1545,14 @@ package body Freeze is
             end if;
          end if;
 
-         --  Freeze components and embedded subtypes
+         --  Freeze components and embedded subtypes.
 
          Comp := First_Entity (Rec);
-         while Present (Comp) loop
-            if not Is_Type (Comp) then
-               Freeze_And_Append (Etype (Comp), Loc, Result);
-            end if;
-
-            --  If the component is an access type with an allocator
-            --  as default value, the designated type will be frozen
-            --  by the corresponding expression in init_proc. In  order
-            --  to place the freeze node for the designated type before
-            --  that for the current record type, freeze it now.
-
-            --  Same process if the component is an array of access types,
-            --  initialized with an aggregate. If the designated type is
-            --  private, it cannot contain allocators, and it is premature
-            --  to freeze the type, so we check for this as well.
-
-            if Is_Access_Type (Etype (Comp))
-              and then Present (Parent (Comp))
-              and then Present (Expression (Parent (Comp)))
-              and then Nkind (Expression (Parent (Comp))) = N_Allocator
-            then
-               declare
-                  Alloc : constant Node_Id := Expression (Parent (Comp));
-
-               begin
-                  --  If component is pointer to a classwide type, freeze
-                  --  the specific type in the expression being allocated.
-                  --  The expression may be a subtype indication, in which
-                  --  case freeze the subtype mark.
+         Prev := Empty;
 
-                  if Is_Class_Wide_Type (Designated_Type (Etype (Comp))) then
-                     if Is_Entity_Name (Expression (Alloc)) then
-                        Freeze_And_Append
-                          (Entity (Expression (Alloc)), Loc, Result);
-                     elsif
-                       Nkind (Expression (Alloc)) = N_Subtype_Indication
-                     then
-                        Freeze_And_Append
-                         (Entity (Subtype_Mark (Expression (Alloc))),
-                           Loc, Result);
-                     end if;
-
-                  elsif Is_Itype (Designated_Type (Etype (Comp))) then
-                     Check_Itype (Designated_Type (Etype (Comp)));
-
-                  else
-                     Freeze_And_Append
-                       (Designated_Type (Etype (Comp)), Loc, Result);
-                  end if;
-               end;
-
-            elsif Is_Access_Type (Etype (Comp))
-              and then Is_Itype (Designated_Type (Etype (Comp)))
-            then
-               Check_Itype (Designated_Type (Etype (Comp)));
-
-            elsif Is_Array_Type (Etype (Comp))
-              and then Is_Access_Type (Component_Type (Etype (Comp)))
-              and then Present (Parent (Comp))
-              and then Nkind (Parent (Comp)) = N_Component_Declaration
-              and then Present (Expression (Parent (Comp)))
-              and then Nkind (Expression (Parent (Comp))) = N_Aggregate
-              and then Is_Fully_Defined
-                 (Designated_Type (Component_Type (Etype (Comp))))
-            then
-               Freeze_And_Append
-                 (Designated_Type
-                   (Component_Type (Etype (Comp))), Loc, Result);
-            end if;
+         while Present (Comp) loop
 
-            --  Processing for real components (exclude anonymous subtypes)
+            --  First handle the (real) component case.
 
             if Ekind (Comp) = E_Component
               or else Ekind (Comp) = E_Discriminant
@@ -1619,6 +1561,23 @@ package body Freeze is
                   CC : constant Node_Id := Component_Clause (Comp);
 
                begin
+                  --  Freezing a record type freezes the type of each of its
+                  --  components. However, if the type of the component is
+                  --  part of this record, we do not want or need a separate
+                  --  Freeze_Node. Note that Is_Itype is wrong because that's
+                  --  also set in private type cases. We also can't check for
+                  --  the Scope being exactly Rec because of private types and
+                  --  record extensions.
+
+                  if Is_Itype (Etype (Comp))
+                    and then Is_Record_Type (Underlying_Type
+                                             (Scope (Etype (Comp))))
+                  then
+                     Undelay_Type (Etype (Comp));
+                  end if;
+
+                  Freeze_And_Append (Etype (Comp), Loc, Result);
+
                   --  Check for error of component clause given for variable
                   --  sized type. We have to delay this test till this point,
                   --  since the component type has to be frozen for us to know
@@ -1779,6 +1738,135 @@ package body Freeze is
                end;
             end if;
 
+            --  If the component is an Itype with Delayed_Freeze and is either
+            --  a record or array subtype and its base type has not yet been
+            --  frozen, we must remove this from the entity list of this
+            --  record and put it on the entity list of the scope of its base
+            --  type. Note that we know that this is not the type of a
+            --  component since we cleared Has_Delayed_Freeze for it in the
+            --  previous loop. Thus this must be the Designated_Type of an
+            --  access type, which is the type of a component.
+
+            if Is_Itype (Comp)
+              and then Is_Type (Scope (Comp))
+              and then Is_Composite_Type (Comp)
+              and then Base_Type (Comp) /= Comp
+              and then Has_Delayed_Freeze (Comp)
+              and then not Is_Frozen (Base_Type (Comp))
+            then
+               declare
+                  Will_Be_Frozen : Boolean := False;
+                  S : Entity_Id := Scope (Rec);
+
+               begin
+                  --  We have a pretty bad kludge here. Suppose Rec is a
+                  --  subtype being defined in a subprogram that's created
+                  --  as part of the freezing of Rec'Base. In that case,
+                  --  we know that Comp'Base must have already been frozen by
+                  --  the time we get to elaborate this because Gigi doesn't
+                  --  elaborate any bodies until it has elaborated all of the
+                  --  declarative part. But Is_Frozen will not be  set at this
+                  --  point because we are processing code in lexical order.
+
+                  --  We detect this case by going up the Scope chain of
+                  --  Rec and seeing if we have a subprogram scope before
+                  --  reaching the top of the scope chain or that of Comp'Base.
+                  --  If we do, then mark that Comp'Base will actually be
+                  --  frozen. If so, we merely undelay it.
+
+                  while Present (S) loop
+                     if Is_Subprogram (S) then
+                        Will_Be_Frozen := True;
+                        exit;
+                     elsif S = Scope (Base_Type (Comp)) then
+                        exit;
+                     end if;
+
+                     S := Scope (S);
+                  end loop;
+
+                  if Will_Be_Frozen then
+                     Undelay_Type (Comp);
+                  else
+                     if Present (Prev) then
+                        Set_Next_Entity (Prev, Next_Entity (Comp));
+                     else
+                        Set_First_Entity (Rec, Next_Entity (Comp));
+                     end if;
+
+                     --  Insert in entity list of scope of base type (which
+                     --  must be an enclosing scope, because still unfrozen).
+
+                     Append_Entity (Comp, Scope (Base_Type (Comp)));
+                  end if;
+               end;
+
+            --  If the component is an access type with an allocator as
+            --  default value, the designated type will be frozen by the
+            --  corresponding expression in init_proc. In order to place the
+            --  freeze node for the designated type before that for the
+            --  current record type, freeze it now.
+
+            --  Same process if the component is an array of access types,
+            --  initialized with an aggregate. If the designated type is
+            --  private, it cannot contain allocators, and it is premature to
+            --  freeze the type, so we check for this as well.
+
+            elsif Is_Access_Type (Etype (Comp))
+              and then Present (Parent (Comp))
+              and then Present (Expression (Parent (Comp)))
+              and then Nkind (Expression (Parent (Comp))) = N_Allocator
+            then
+               declare
+                  Alloc : constant Node_Id := Expression (Parent (Comp));
+
+               begin
+                  --  If component is pointer to a classwide type, freeze
+                  --  the specific type in the expression being allocated.
+                  --  The expression may be a subtype indication, in which
+                  --  case freeze the subtype mark.
+
+                  if Is_Class_Wide_Type (Designated_Type (Etype (Comp))) then
+                     if Is_Entity_Name (Expression (Alloc)) then
+                        Freeze_And_Append
+                          (Entity (Expression (Alloc)), Loc, Result);
+                     elsif
+                       Nkind (Expression (Alloc)) = N_Subtype_Indication
+                     then
+                        Freeze_And_Append
+                         (Entity (Subtype_Mark (Expression (Alloc))),
+                           Loc, Result);
+                     end if;
+
+                  elsif Is_Itype (Designated_Type (Etype (Comp))) then
+                     Check_Itype (Designated_Type (Etype (Comp)));
+
+                  else
+                     Freeze_And_Append
+                       (Designated_Type (Etype (Comp)), Loc, Result);
+                  end if;
+               end;
+
+            elsif Is_Access_Type (Etype (Comp))
+              and then Is_Itype (Designated_Type (Etype (Comp)))
+            then
+               Check_Itype (Designated_Type (Etype (Comp)));
+
+            elsif Is_Array_Type (Etype (Comp))
+              and then Is_Access_Type (Component_Type (Etype (Comp)))
+              and then Present (Parent (Comp))
+              and then Nkind (Parent (Comp)) = N_Component_Declaration
+              and then Present (Expression (Parent (Comp)))
+              and then Nkind (Expression (Parent (Comp))) = N_Aggregate
+              and then Is_Fully_Defined
+                 (Designated_Type (Component_Type (Etype (Comp))))
+            then
+               Freeze_And_Append
+                 (Designated_Type
+                   (Component_Type (Etype (Comp))), Loc, Result);
+            end if;
+
+            Prev := Comp;
             Next_Entity (Comp);
          end loop;
 
@@ -1882,17 +1970,28 @@ package body Freeze is
    --  Start of processing for Freeze_Entity
 
    begin
+      --  We are going to test for various reasons why this entity need not be
+      --  frozen here, but in the case of an Itype that's defined within a
+      --  record, that test actually applies to the record.
+
+      if Is_Itype (E) and then Is_Record_Type (Scope (E)) then
+         Test_E := Scope (E);
+      elsif Is_Itype (E) and then Present (Underlying_Type (Scope (E)))
+        and then Is_Record_Type (Underlying_Type (Scope (E)))
+      then
+         Test_E := Underlying_Type (Scope (E));
+      end if;
+
       --  Do not freeze if already frozen since we only need one freeze node
 
       if Is_Frozen (E) then
          return No_List;
 
-      --  It is improper to freeze an external entity within a generic
-      --  because its freeze node will appear in a non-valid context.
-      --  The entity will be frozen in the proper scope after the current
-      --  generic is analyzed.
+      --  It is improper to freeze an external entity within a generic because
+      --  its freeze node will appear in a non-valid context. The entity will
+      --  be frozen in the proper scope after the current generic is analyzed.
 
-      elsif Inside_A_Generic and then External_Ref_In_Generic (E) then
+      elsif Inside_A_Generic and then External_Ref_In_Generic (Test_E) then
          return No_List;
 
       --  Do not freeze a global entity within an inner scope created during
@@ -1906,9 +2005,9 @@ package body Freeze is
       --  comes from source, or is a generic instance, then the freeze point
       --  is the one mandated by the language. and we freze the entity.
 
-      elsif In_Open_Scopes (Scope (E))
-        and then Scope (E) /= Current_Scope
-        and then Ekind (E) /= E_Constant
+      elsif In_Open_Scopes (Scope (Test_E))
+        and then Scope (Test_E) /= Current_Scope
+        and then Ekind (Test_E) /= E_Constant
       then
          declare
             S : Entity_Id := Current_Scope;
@@ -1940,10 +2039,11 @@ package body Freeze is
 
       elsif Front_End_Inlining
         and then  In_Instance_Body
-        and then Present (Scope (E))
+        and then Present (Scope (Test_E))
       then
          declare
-            S : Entity_Id := Scope (E);
+            S : Entity_Id := Scope (Test_E);
+
          begin
             while Present (S) loop
                if Is_Generic_Instance (S) then
@@ -2694,6 +2794,12 @@ package body Freeze is
                   Freeze_And_Append (Comp, Loc, Result);
 
                elsif (Ekind (Comp)) /= E_Function then
+                  if Is_Itype (Etype (Comp))
+                    and then Underlying_Type (Scope (Etype (Comp))) = E
+                  then
+                     Undelay_Type (Etype (Comp));
+                  end if;
+
                   Freeze_And_Append (Etype (Comp), Loc, Result);
                end if;
 
@@ -2904,66 +3010,8 @@ package body Freeze is
             Check_Restriction (No_Standard_Storage_Pools, E);
          end if;
 
-         --  If the current entity is an array or record subtype and has
-         --  discriminants used to constrain it, it must not freeze, because
-         --  Freeze_Entity nodes force Gigi to process the frozen type.
-
          if Is_Composite_Type (E) then
 
-            if Is_Array_Type (E) then
-               declare
-                  Index : Node_Id := First_Index (E);
-                  Expr1 : Node_Id;
-                  Expr2 : Node_Id;
-
-               begin
-                  while Present (Index) loop
-                     if Etype (Index) /= Any_Type then
-                        Get_Index_Bounds (Index, Expr1, Expr2);
-
-                        for J in 1 .. 2 loop
-                           if Nkind (Expr1) = N_Identifier
-                             and then Ekind (Entity (Expr1)) = E_Discriminant
-                           then
-                              Set_Has_Delayed_Freeze (E, False);
-                              Set_Freeze_Node (E, Empty);
-                              Check_Debug_Info_Needed (E);
-                              return Result;
-                           end if;
-
-                           Expr1 := Expr2;
-                        end loop;
-                     end if;
-
-                     Next_Index (Index);
-                  end loop;
-               end;
-
-            elsif Has_Discriminants (E)
-              and Is_Constrained (E)
-            then
-               declare
-                  Constraint : Elmt_Id;
-                  Expr       : Node_Id;
-
-               begin
-                  Constraint := First_Elmt (Discriminant_Constraint (E));
-                  while Present (Constraint) loop
-                     Expr := Node (Constraint);
-                     if Nkind (Expr) = N_Identifier
-                       and then Ekind (Entity (Expr)) = E_Discriminant
-                     then
-                        Set_Has_Delayed_Freeze (E, False);
-                        Set_Freeze_Node (E, Empty);
-                        Check_Debug_Info_Needed (E);
-                        return Result;
-                     end if;
-
-                     Next_Elmt (Constraint);
-                  end loop;
-               end;
-            end if;
-
             --  AI-117 requires that all new primitives of a tagged type
             --  must inherit the convention of the full view of the type.
             --  Inherited and overriding operations are defined to inherit
@@ -3065,7 +3113,7 @@ package body Freeze is
          --  in particular the size and alignment values. This processing is
          --  not required for generic types, since generic types do not play
          --  any part in code generation, and so the size and alignment values
-         --  for suhc types are irrelevant.
+         --  for such types are irrelevant.
 
          if Is_Generic_Type (E) then
             return Result;
@@ -3242,7 +3290,7 @@ package body Freeze is
 
       function In_Exp_Body (N : Node_Id) return Boolean;
       --  Given an N_Handled_Sequence_Of_Statements node N, determines whether
-      --  it is the handled statement sequence of an expander generated
+      --  it is the handled statement sequence of an expander-generated
       --  subprogram (init proc, or stream subprogram). If so, it returns
       --  True, otherwise False.
 
@@ -3607,6 +3655,11 @@ package body Freeze is
       --  specification, the scope is still void. The expression can also
       --  appear in the discriminant part of a private or concurrent type.
 
+      --  If the expression appears in a constrained subcomponent of an
+      --  enclosing record declaration, the freeze nodes must be attached
+      --  to the outer record type so they can eventually be placed in the
+      --  enclosing declaration list.
+
       --  The other case requiring this special handling is if we are in
       --  a default expression, since in that case we are about to freeze
       --  a static type, and the freeze scope needs to be the outer scope,
@@ -3626,6 +3679,7 @@ package body Freeze is
          declare
             Loc          : constant Source_Ptr := Sloc (Current_Scope);
             Freeze_Nodes : List_Id := No_List;
+            Pos          : Int := Scope_Stack.Last;
 
          begin
             if Present (Desig_Typ) then
@@ -3640,16 +3694,21 @@ package body Freeze is
                Freeze_And_Append (Nam, Loc, Freeze_Nodes);
             end if;
 
+            --  The current scope may be that of a constrained component of
+            --  an enclosing record declaration, which is above the current
+            --  scope in the scope stack.
+
+            if Is_Record_Type (Scope (Current_Scope)) then
+               Pos := Pos - 1;
+            end if;
+
             if Is_Non_Empty_List (Freeze_Nodes) then
-               if No (Scope_Stack.Table
-                 (Scope_Stack.Last).Pending_Freeze_Actions)
-               then
-                  Scope_Stack.Table
-                    (Scope_Stack.Last).Pending_Freeze_Actions :=
+               if No (Scope_Stack.Table (Pos).Pending_Freeze_Actions) then
+                  Scope_Stack.Table (Pos).Pending_Freeze_Actions :=
                       Freeze_Nodes;
                else
                   Append_List (Freeze_Nodes, Scope_Stack.Table
-                                   (Scope_Stack.Last).Pending_Freeze_Actions);
+                                   (Pos).Pending_Freeze_Actions);
                end if;
             end if;
          end;
@@ -4728,6 +4787,44 @@ package body Freeze is
    end Set_Debug_Info_Needed;
 
    ------------------
+   -- Undelay_Type --
+   ------------------
+
+   procedure Undelay_Type (T : Entity_Id) is
+   begin
+      Set_Has_Delayed_Freeze (T, False);
+      Set_Freeze_Node (T, Empty);
+
+      --  Since we don't want T to have a Freeze_Node, we don't want its
+      --  Full_View or Corresponding_Record_Type to have one either.
+
+      --  ??? Fundamentally, this whole handling is a kludge. What we really
+      --  want is to be sure that for an Itype that's part of record R and is
+      --  a subtype of type T, that it's frozen after the later of the freeze
+      --  points of R and T. We have no way of doing that directly, so what we
+      --  do is force most such Itypes to be frozen as part of freezing R via
+      --  this procedure and only delay the ones that need to be delayed
+      --  (mostly the designated types of access types that are defined as
+      --  part of the record).
+
+      if Is_Private_Type (T)
+        and then Present (Full_View (T))
+        and then Is_Itype (Full_View (T))
+        and then Is_Record_Type (Scope (Full_View (T)))
+      then
+         Undelay_Type (Full_View (T));
+      end if;
+
+      if Is_Concurrent_Type (T)
+        and then Present (Corresponding_Record_Type (T))
+        and then Is_Itype (Corresponding_Record_Type (T))
+        and then Is_Record_Type (Scope (Corresponding_Record_Type (T)))
+      then
+         Undelay_Type (Corresponding_Record_Type (T));
+      end if;
+   end Undelay_Type;
+
+   ------------------
    -- Warn_Overlay --
    ------------------