ada: Crash initializing component of private record type

The compiler may crash processing the full type declaration of a
private record type that initializes a component with a call to
a function instantiated in the private part of the package.

gcc/ada/

	* freeze.adb (Declared_In_Expanded_Body): New subprogram.
	(In_Expanded_Body): Minor code cleanup.
	(Freeze_Expression): Code cleanup plus factorize in a new function
	the code that identifies entities declared in the body of expander
	generated subprograms, since such case must be checked also for
	other node kinds when climbing the tree to locate the place to
	insert the freezing node.

1 files changed, 89 insertions, 85 deletions

diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 6109913..4a5dd53 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -8047,6 +8047,16 @@ package body Freeze is
 
    procedure Freeze_Expression (N : Node_Id) is
 
+      function Declared_In_Expanded_Body
+        (N   : Node_Id;
+         Typ : Entity_Id;
+         Nam : Entity_Id) return Boolean;
+      --  Given the N_Handled_Sequence_Of_Statements node of an expander
+      --  generated subprogram body, determines if the frozen entity is
+      --  declared inside this body. This is recognized locating the
+      --  enclosing subprogram of the entity Name or its Type and
+      --  checking if it is this subprogram body.
+
       function Find_Aggregate_Component_Desig_Type return Entity_Id;
       --  If the expression is an array aggregate, the type of the component
       --  expressions is also frozen. If the component type is an access type
@@ -8067,6 +8077,45 @@ package body Freeze is
       --  Determines whether an entity E referenced in node N is declared in
       --  the list L.
 
+      -------------------------------
+      -- Declared_In_Expanded_Body --
+      -------------------------------
+
+      function Declared_In_Expanded_Body
+        (N   : Node_Id;
+         Typ : Entity_Id;
+         Nam : Entity_Id) return Boolean
+      is
+         pragma Assert (In_Expanded_Body (N));
+
+         Subp_Body : constant Node_Id := Parent (N);
+         Subp_Id   : Entity_Id;
+         Scop      : Entity_Id;
+
+      begin
+         if Acts_As_Spec (Subp_Body) then
+            Subp_Id := Unique_Defining_Entity (Specification (Subp_Body));
+         else
+            Subp_Id := Corresponding_Spec (Subp_Body);
+         end if;
+
+         if Present (Typ) then
+            Scop := Scope (Typ);
+         elsif Present (Nam) then
+            Scop := Scope (Nam);
+         else
+            Scop := Standard_Standard;
+         end if;
+
+         while Scop /= Standard_Standard
+           and then not Is_Subprogram (Scop)
+         loop
+            Scop := Scope (Scop);
+         end loop;
+
+         return Scop = Subp_Id;
+      end Declared_In_Expanded_Body;
+
       -----------------------------------------
       -- Find_Aggregate_Component_Desig_Type --
       -----------------------------------------
@@ -8113,11 +8162,13 @@ package body Freeze is
          if Nkind (P) /= N_Subprogram_Body then
             return False;
 
-         --  AI12-0157: An expression function that is a completion is a freeze
-         --  point. If the body is the result of expansion, it is not.
+         --  Treat the generated body of an expression function like other
+         --  bodies generated during expansion (e.g. stream subprograms) so
+         --  that those bodies are not treated as freezing points.
 
          elsif Was_Expression_Function (P) then
-            return not Comes_From_Source (P);
+            pragma Assert (not Comes_From_Source (P));
+            return True;
 
          --  This is the body of a generated predicate function
 
@@ -8185,14 +8236,6 @@ package body Freeze is
 
       Allocator_Typ : Entity_Id := Empty;
 
-      Freeze_Outside : Boolean := False;
-      --  This flag is set true if the entity must be frozen outside the
-      --  current subprogram. This happens in the case of expander generated
-      --  subprograms (_Init_Proc, _Input, _Output, _Read, _Write) which do
-      --  not freeze all entities like other bodies, but which nevertheless
-      --  may reference entities that have to be frozen before the body and
-      --  obviously cannot be frozen inside the body.
-
       Freeze_Outside_Subp  : Entity_Id := Empty;
       --  This entity is set if we are inside a subprogram body and the frozen
       --  entity is defined in the enclosing scope of this subprogram. In such
@@ -8537,79 +8580,11 @@ package body Freeze is
                   --  An exception occurs when the sequence of statements is
                   --  for an expander generated body that did not do the usual
                   --  freeze all operation. In this case we usually want to
-                  --  freeze outside this body, not inside it, and we skip
-                  --  past the subprogram body that we are inside.
-
-                  if In_Expanded_Body (Parent_P) then
-                     declare
-                        Subp_Body : constant Node_Id := Parent (Parent_P);
-                        Spec_Id   : Entity_Id;
-
-                     begin
-                        --  Freeze the entity only when it is declared inside
-                        --  the body of the expander generated procedure. This
-                        --  case is recognized by the subprogram scope of the
-                        --  entity or its type, which is either the spec of an
-                        --  enclosing body, or (in the case of init_procs for
-                        --  which there is no separate spec) the current scope.
-
-                        if Nkind (Subp_Body) = N_Subprogram_Body then
-                           declare
-                              S : Entity_Id;
-
-                           begin
-                              Spec_Id := Corresponding_Spec (Subp_Body);
-
-                              if Present (Typ) then
-                                 S := Scope (Typ);
-                              elsif Present (Nam) then
-                                 S := Scope (Nam);
-                              else
-                                 S := Standard_Standard;
-                              end if;
-
-                              while S /= Standard_Standard
-                                and then not Is_Subprogram (S)
-                              loop
-                                 S := Scope (S);
-                              end loop;
-
-                              if S = Spec_Id then
-                                 exit;
-
-                              elsif Present (Typ)
-                                and then Scope (Typ) = Current_Scope
-                                and then
-                                  Defining_Entity (Subp_Body) = Current_Scope
-                              then
-                                 exit;
-                              end if;
-                           end;
-                        end if;
-
-                        --  If the entity is not frozen by an expression
-                        --  function that is not a completion, continue
-                        --  climbing the tree.
+                  --  freeze outside this body, not inside it, unless the
+                  --  entity is declared inside this expander generated body.
 
-                        if Nkind (Subp_Body) = N_Subprogram_Body
-                          and then Was_Expression_Function (Subp_Body)
-                        then
-                           null;
-
-                        --  Freeze outside the body
-
-                        else
-                           Parent_P := Parent (Parent_P);
-                           Freeze_Outside := True;
-                        end if;
-                     end;
-
-                  --  Here if normal case where we are in handled statement
-                  --  sequence and want to do the insertion right there.
-
-                  else
-                     exit;
-                  end if;
+                  exit when not In_Expanded_Body (Parent_P)
+                    or else Declared_In_Expanded_Body (Parent_P, Typ, Nam);
 
                --  If parent is a body or a spec or a block, then the current
                --  node is a statement or declaration and we can insert the
@@ -8645,7 +8620,37 @@ package body Freeze is
                   | N_Selective_Accept
                   | N_Triggering_Alternative
                =>
-                  exit when Is_List_Member (P);
+                  if No (Current_Subprogram) then
+                     exit when Is_List_Member (P);
+
+                  --  Check exceptional case documented above for an enclosing
+                  --  handled sequence of statements.
+
+                  else
+                     declare
+                        Par : Node_Id := Parent (Parent_P);
+
+                     begin
+                        while Present (Par)
+                          and then
+                            Nkind (Par) /= N_Handled_Sequence_Of_Statements
+                          and then Nkind (Parent (Par)) /= N_Subprogram_Body
+                        loop
+                           Par := Parent (Par);
+                        end loop;
+
+                        --  If we don't have a parent, then we are not in a
+                        --  well-formed tree and we ignore the freeze request.
+                        --  See previous comment in the enclosing loop.
+
+                        if No (Par) then
+                           return;
+                        end if;
+
+                        exit when not In_Expanded_Body (Par)
+                          or else Declared_In_Expanded_Body (Par, Typ, Nam);
+                     end;
+                  end if;
 
                --  The freeze nodes produced by an expression coming from the
                --  Actions list of an N_Expression_With_Actions, short-circuit
@@ -8735,7 +8740,6 @@ package body Freeze is
       --  placing them at the proper place, after the generic unit.
 
       if (In_Spec_Exp and not Inside_A_Generic)
-        or else Freeze_Outside
         or else (Is_Type (Current_Scope)
                   and then (not Is_Concurrent_Type (Current_Scope)
                              or else not Has_Completion (Current_Scope)))