[Ada] Crash processing abstract state aspect of a package

Message ID 20180717082353.GA1438@adacore.com
State New
Headers show
Series
  • [Ada] Crash processing abstract state aspect of a package
Related show

Commit Message

Pierre-Marie de Rodat July 17, 2018, 8:23 a.m.
The compiler may crash processing an aspect Part_Of used in a
package spec which has also an Initial_Condition aspect. After
this patch the following test compiles fine.

package P
with
  SPARK_Mode => On,
  Abstract_State => (Count_State),
  Initial_Condition => (Get_Count = 0)              -- Test
is
   type Count_Type is range 0 .. 16;

   function Get_Count return Count_Type;

   procedure Dummy;

private
   C: Count_Type := 0 with Part_Of => Count_State;  -- Test

   function Get_Count return Count_Type is (C);
end P;

package body P
with
  SPARK_Mode => On,
  Refined_State => (Count_State => C)
is
  procedure Dummy is null;
end P;

Command: gcc -c p.adb

Tested on x86_64-pc-linux-gnu, committed on trunk

2018-07-17  Javier Miranda  <miranda@adacore.com>

gcc/ada/

	* exp_ch13.adb (Expand_N_Freeze_Entity): Handle subtype declared for an
	iterator.
	* freeze.adb (Freeze_Expression): Handle freeze of an entity defined
	outside of a subprogram body. This case was previously handled during
	preanalysis; the frozen entities were remembered and left pending until
	we continued freezeing entities outside of the subprogram. Now, when
	climbing the parents chain to locate the correct placement for the
	freezeing node, we check if the entity can be frozen and only when no
	enclosing node is marked as Must_Not_Freeze the entity is frozen.
	* sem_ch3.ads (Preanalyze_Default_Expression): Declaration moved to the
	package body.
	* sem_ch3.adb (Preanalyze_Default_Expression): Code adjusted to invoke
	the new subprogram Preanalyze_With_Freezing_And_Resolve.
	* sem_ch6.adb (Preanalyze_Formal_Expression): New subprogram.
	(Analyze_Expression_Function, Process_Formals): Invoke
	Preanalyze_Formal_Expression instead of Preanalyze_Spec_Expression
	since the analysis of the formals may freeze entities.
	(Analyze_Subprogram_Body_Helper): Skip building the body of the
	class-wide clone for eliminated subprograms.
	* sem_res.ads, sem_res.adb (Preanalyze_And_Resolve): New subprogram.
	Its code is basically the previous version of this routine but extended
	with an additional parameter which is used to specify if during
	preanalysis we are allowed to freeze entities.  If the new parameter is
	True then the subtree root node is marked as Must_Not_Freeze and no
	entities are frozen during preanalysis.
	(Preanalyze_And_Resolve): Invokes the internal version of
	Preanalyze_And_Resolve without entity freezing.
	(Preanalyze_With_Freezing_And_Resolve): Invokes the internal version of
	Prenalyze_And_Resolve with freezing enabled.

Patch

--- gcc/ada/exp_ch13.adb
+++ gcc/ada/exp_ch13.adb
@@ -470,6 +470,11 @@  package body Exp_Ch13 is
         and then Ekind (E_Scope) not in Concurrent_Kind
       then
          E_Scope := Scope (E_Scope);
+
+      --  The entity may be a subtype declared for an iterator.
+
+      elsif Ekind (E_Scope) = E_Loop then
+         E_Scope := Scope (E_Scope);
       end if;
 
       --  Remember that we are processing a freezing entity and its freezing

--- gcc/ada/freeze.adb
+++ gcc/ada/freeze.adb
@@ -6936,20 +6936,6 @@  package body Freeze is
    -----------------------
 
    procedure Freeze_Expression (N : Node_Id) is
-      In_Spec_Exp : constant Boolean := In_Spec_Expression;
-      Typ         : Entity_Id;
-      Nam         : Entity_Id;
-      Desig_Typ   : Entity_Id;
-      P           : Node_Id;
-      Parent_P    : Node_Id;
-
-      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.
 
       function Find_Aggregate_Component_Desig_Type return Entity_Id;
       --  If the expression is an array aggregate, the type of the component
@@ -7038,6 +7024,29 @@  package body Freeze is
          end if;
       end In_Expanded_Body;
 
+      --  Local variables
+
+      In_Spec_Exp : constant Boolean := In_Spec_Expression;
+      Typ         : Entity_Id;
+      Nam         : Entity_Id;
+      Desig_Typ   : Entity_Id;
+      P           : Node_Id;
+      Parent_P    : Node_Id;
+
+      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
+      --  case we must skip the subprogram body when climbing the parents chain
+      --  to locate the correct placement for the freezing node.
+
    --  Start of processing for Freeze_Expression
 
    begin
@@ -7181,253 +7190,333 @@  package body Freeze is
          return;
       end if;
 
-      --  Examine the enclosing context by climbing the parent chain. The
-      --  traversal serves two purposes - to detect scenarios where freezeing
-      --  is not needed and to find the proper insertion point for the freeze
-      --  nodes. Although somewhat similar to Insert_Actions, this traversal
-      --  is freezing semantics-sensitive. Inserting freeze nodes blindly in
-      --  the tree may result in types being frozen too early.
+      --  Check if we are inside a subprogram body and the frozen entity is
+      --  defined in the enclosing scope of this subprogram. In such case we
+      --  must skip the subprogram when climbing the parents chain to locate
+      --  the correct placement for the freezing node.
+
+      --  This is not needed for default expressions and other spec expressions
+      --  in generic units since the Move_Freeze_Nodes mechanism (sem_ch12.adb)
+      --  takes care of placing them at the proper place, after the generic
+      --  unit.
+
+      if Present (Nam)
+        and then Scope (Nam) /= Current_Scope
+        and then not (In_Spec_Exp and then Inside_A_Generic)
+      then
+         declare
+            S : Entity_Id := Current_Scope;
+
+         begin
+            while Present (S)
+              and then In_Same_Source_Unit (Nam, S)
+            loop
+               if Scope (S) = Scope (Nam) then
+                  if Is_Subprogram (S) and then Has_Completion (S) then
+                     Freeze_Outside_Subp := S;
+                  end if;
+
+                  exit;
+               end if;
+
+               S := Scope (S);
+            end loop;
+         end;
+      end if;
+
+      --  Examine the enclosing context by climbing the parent chain.
+
+      --  If we identified that we must freeze the entity outside of a given
+      --  subprogram then we just climb up to that subprogram checking if some
+      --  enclosing node is marked as Must_Not_Freeze (since in such case we
+      --  must not freeze yet this entity).
 
       P := N;
-      loop
-         Parent_P := Parent (P);
 
-         --  If we don't have a parent, then we are not in a well-formed tree.
-         --  This is an unusual case, but there are some legitimate situations
-         --  in which this occurs, notably when the expressions in the range of
-         --  a type declaration are resolved. We simply ignore the freeze
-         --  request in this case. Is this right ???
+      if Present (Freeze_Outside_Subp) then
+         loop
+            --  Do not freeze the current expression if another expression in
+            --  the chain of parents must not be frozen.
 
-         if No (Parent_P) then
-            return;
-         end if;
+            if Nkind (P) in N_Subexpr and then Must_Not_Freeze (P) then
+               return;
+            end if;
 
-         --  See if we have got to an appropriate point in the tree
+            Parent_P := Parent (P);
 
-         case Nkind (Parent_P) is
+            --  If we don't have a parent, then we are not in a well-formed
+            --  tree. This is an unusual case, but there are some legitimate
+            --  situations in which this occurs, notably when the expressions
+            --  in the range of a type declaration are resolved. We simply
+            --  ignore the freeze request in this case.
 
-            --  A special test for the exception of (RM 13.14(8)) for the case
-            --  of per-object expressions (RM 3.8(18)) occurring in component
-            --  definition or a discrete subtype definition. Note that we test
-            --  for a component declaration which includes both cases we are
-            --  interested in, and furthermore the tree does not have explicit
-            --  nodes for either of these two constructs.
+            if No (Parent_P) then
+               return;
+            end if;
 
-            when N_Component_Declaration =>
+            exit when Nkind (Parent_P) = N_Subprogram_Body
+              and then Unique_Defining_Entity (Parent_P) = Freeze_Outside_Subp;
 
-               --  The case we want to test for here is an identifier that is
-               --  a per-object expression, this is either a discriminant that
-               --  appears in a context other than the component declaration
-               --  or it is a reference to the type of the enclosing construct.
+            P := Parent_P;
+         end loop;
 
-               --  For either of these cases, we skip the freezing
+      --  Otherwise the traversal serves two purposes - to detect scenarios
+      --  where freezeing is not needed and to find the proper insertion point
+      --  for the freeze nodes. Although somewhat similar to Insert_Actions,
+      --  this traversal is freezing semantics-sensitive. Inserting freeze
+      --  nodes blindly in the tree may result in types being frozen too early.
 
-               if not In_Spec_Expression
-                 and then Nkind (N) = N_Identifier
-                 and then (Present (Entity (N)))
-               then
-                  --  We recognize the discriminant case by just looking for
-                  --  a reference to a discriminant. It can only be one for
-                  --  the enclosing construct. Skip freezing in this case.
+      else
+         loop
+            --  Do not freeze the current expression if another expression in
+            --  the chain of parents must not be frozen.
 
-                  if Ekind (Entity (N)) = E_Discriminant then
-                     return;
+            if Nkind (P) in N_Subexpr and then Must_Not_Freeze (P) then
+               return;
+            end if;
 
-                  --  For the case of a reference to the enclosing record,
-                  --  (or task or protected type), we look for a type that
-                  --  matches the current scope.
+            Parent_P := Parent (P);
 
-                  elsif Entity (N) = Current_Scope then
-                     return;
-                  end if;
-               end if;
+            --  If we don't have a parent, then we are not in a well-formed
+            --  tree. This is an unusual case, but there are some legitimate
+            --  situations in which this occurs, notably when the expressions
+            --  in the range of a type declaration are resolved. We simply
+            --  ignore the freeze request in this case. Is this right ???
 
-            --  If we have an enumeration literal that appears as the choice in
-            --  the aggregate of an enumeration representation clause, then
-            --  freezing does not occur (RM 13.14(10)).
+            if No (Parent_P) then
+               return;
+            end if;
 
-            when N_Enumeration_Representation_Clause =>
+            --  See if we have got to an appropriate point in the tree
 
-               --  The case we are looking for is an enumeration literal
+            case Nkind (Parent_P) is
 
-               if (Nkind (N) = N_Identifier or Nkind (N) = N_Character_Literal)
-                 and then Is_Enumeration_Type (Etype (N))
-               then
-                  --  If enumeration literal appears directly as the choice,
-                  --  do not freeze (this is the normal non-overloaded case)
+               --  A special test for the exception of (RM 13.14(8)) for the
+               --  case of per-object expressions (RM 3.8(18)) occurring in
+               --  component definition or a discrete subtype definition. Note
+               --  that we test for a component declaration which includes both
+               --  cases we are interested in, and furthermore the tree does
+               --  not have explicit nodes for either of these two constructs.
+
+               when N_Component_Declaration =>
+
+                  --  The case we want to test for here is an identifier that
+                  --  is a per-object expression, this is either a discriminant
+                  --  that appears in a context other than the component
+                  --  declaration or it is a reference to the type of the
+                  --  enclosing construct.
 
-                  if Nkind (Parent (N)) = N_Component_Association
-                    and then First (Choices (Parent (N))) = N
+                  --  For either of these cases, we skip the freezing
+
+                  if not In_Spec_Expression
+                    and then Nkind (N) = N_Identifier
+                    and then (Present (Entity (N)))
                   then
-                     return;
+                     --  We recognize the discriminant case by just looking for
+                     --  a reference to a discriminant. It can only be one for
+                     --  the enclosing construct. Skip freezing in this case.
 
-                  --  If enumeration literal appears as the name of function
-                  --  which is the choice, then also do not freeze. This
-                  --  happens in the overloaded literal case, where the
-                  --  enumeration literal is temporarily changed to a function
-                  --  call for overloading analysis purposes.
+                     if Ekind (Entity (N)) = E_Discriminant then
+                        return;
 
-                  elsif Nkind (Parent (N)) = N_Function_Call
-                     and then
-                       Nkind (Parent (Parent (N))) = N_Component_Association
-                     and then
-                       First (Choices (Parent (Parent (N)))) = Parent (N)
+                     --  For the case of a reference to the enclosing record,
+                     --  (or task or protected type), we look for a type that
+                     --  matches the current scope.
+
+                     elsif Entity (N) = Current_Scope then
+                        return;
+                     end if;
+                  end if;
+
+               --  If we have an enumeration literal that appears as the choice
+               --  in the aggregate of an enumeration representation clause,
+               --  then freezing does not occur (RM 13.14(10)).
+
+               when N_Enumeration_Representation_Clause =>
+
+                  --  The case we are looking for is an enumeration literal
+
+                  if Nkind_In (N, N_Identifier, N_Character_Literal)
+                    and then Is_Enumeration_Type (Etype (N))
                   then
-                     return;
+                     --  If enumeration literal appears directly as the choice,
+                     --  do not freeze (this is the normal non-overloaded case)
+
+                     if Nkind (Parent (N)) = N_Component_Association
+                       and then First (Choices (Parent (N))) = N
+                     then
+                        return;
+
+                     --  If enumeration literal appears as the name of function
+                     --  which is the choice, then also do not freeze. This
+                     --  happens in the overloaded literal case, where the
+                     --  enumeration literal is temporarily changed to a
+                     --  function call for overloading analysis purposes.
+
+                     elsif Nkind (Parent (N)) = N_Function_Call
+                        and then
+                          Nkind (Parent (Parent (N))) = N_Component_Association
+                        and then
+                          First (Choices (Parent (Parent (N)))) = Parent (N)
+                     then
+                        return;
+                     end if;
                   end if;
-               end if;
 
-            --  Normally if the parent is a handled sequence of statements,
-            --  then the current node must be a statement, and that is an
-            --  appropriate place to insert a freeze node.
+               --  Normally if the parent is a handled sequence of statements,
+               --  then the current node must be a statement, and that is an
+               --  appropriate place to insert a freeze node.
 
-            when N_Handled_Sequence_Of_Statements =>
+               when N_Handled_Sequence_Of_Statements =>
 
-               --  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.
+                  --  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 : constant Node_Id := Parent (Parent_P);
-                     Spec : Entity_Id;
+                  if In_Expanded_Body (Parent_P) then
+                     declare
+                        Subp : constant Node_Id := Parent (Parent_P);
+                        Spec : 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 scope of the entity or its type,
-                     --  which is either the spec for some enclosing body, or
-                     --  (in the case of init_procs, for which there are no
-                     --  separate specs) the current scope.
-
-                     if Nkind (Subp) = N_Subprogram_Body then
-                        Spec := Corresponding_Spec (Subp);
-
-                        if (Present (Typ) and then Scope (Typ) = Spec)
-                             or else
-                           (Present (Nam) and then Scope (Nam) = Spec)
-                        then
-                           exit;
+                     begin
+                        --  Freeze the entity only when it is declared inside
+                        --  the body of the expander generated procedure.
+                        --  This case is recognized by the scope of the entity
+                        --  or its type, which is either the spec for some
+                        --  enclosing body, or (in the case of init_procs,
+                        --  for which there are no separate specs) the current
+                        --  scope.
+
+                        if Nkind (Subp) = N_Subprogram_Body then
+                           Spec := Corresponding_Spec (Subp);
+
+                           if (Present (Typ) and then Scope (Typ) = Spec)
+                                or else
+                              (Present (Nam) and then Scope (Nam) = Spec)
+                           then
+                              exit;
 
-                        elsif Present (Typ)
-                          and then Scope (Typ) = Current_Scope
-                          and then Defining_Entity (Subp) = Current_Scope
-                        then
-                           exit;
+                           elsif Present (Typ)
+                             and then Scope (Typ) = Current_Scope
+                             and then Defining_Entity (Subp) = Current_Scope
+                           then
+                              exit;
+                           end if;
                         end if;
-                     end if;
 
-                     --  An expression function may act as a completion of
-                     --  a function declaration. As such, it can reference
-                     --  entities declared between the two views:
+                        --  An expression function may act as a completion of
+                        --  a function declaration. As such, it can reference
+                        --  entities declared between the two views:
 
-                     --     Hidden [];                             -- 1
-                     --     function F return ...;
-                     --     private
-                     --        function Hidden return ...;
-                     --        function F return ... is (Hidden);  -- 2
+                        --     Hidden [];                             -- 1
+                        --     function F return ...;
+                        --     private
+                        --        function Hidden return ...;
+                        --        function F return ... is (Hidden);  -- 2
 
-                     --  Refering to the example above, freezing the expression
-                     --  of F (2) would place Hidden's freeze node (1) in the
-                     --  wrong place. Avoid explicit freezing and let the usual
-                     --  scenarios do the job - for example, reaching the end
-                     --  of the private declarations, or a call to F.
+                        --  Refering to the example above, freezing the
+                        --  expression of F (2) would place Hidden's freeze
+                        --  node (1) in the wrong place. Avoid explicit
+                        --  freezing and let the usual scenarios do the job
+                        --  (for example, reaching the end of the private
+                        --  declarations, or a call to F.)
 
-                     if Nkind (Original_Node (Subp)) =
-                                                N_Expression_Function
-                     then
-                        null;
+                        if Nkind (Original_Node (Subp)) = N_Expression_Function
+                        then
+                           null;
 
-                     --  Freeze outside the body
+                        --  Freeze outside the body
 
-                     else
-                        Parent_P := Parent (Parent_P);
-                        Freeze_Outside := True;
-                     end if;
-                  end;
+                        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.
+                  --  Here if normal case where we are in handled statement
+                  --  sequence and want to do the insertion right there.
 
-               else
-                  exit;
-               end if;
+                  else
+                     exit;
+                  end if;
 
-            --  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 freeze node
-            --  before it.
-
-            when N_Block_Statement
-               | N_Entry_Body
-               | N_Package_Body
-               | N_Package_Specification
-               | N_Protected_Body
-               | N_Subprogram_Body
-               | N_Task_Body
-            =>
-               exit;
-
-            --  The expander is allowed to define types in any statements list,
-            --  so any of the following parent nodes also mark a freezing point
-            --  if the actual node is in a list of statements or declarations.
-
-            when N_Abortable_Part
-               | N_Accept_Alternative
-               | N_And_Then
-               | N_Case_Statement_Alternative
-               | N_Compilation_Unit_Aux
-               | N_Conditional_Entry_Call
-               | N_Delay_Alternative
-               | N_Elsif_Part
-               | N_Entry_Call_Alternative
-               | N_Exception_Handler
-               | N_Extended_Return_Statement
-               | N_Freeze_Entity
-               | N_If_Statement
-               | N_Or_Else
-               | N_Selective_Accept
-               | N_Triggering_Alternative
-            =>
-               exit when Is_List_Member (P);
-
-            --  Freeze nodes produced by an expression coming from the Actions
-            --  list of a N_Expression_With_Actions node must remain within the
-            --  Actions list. Inserting the freeze nodes further up the tree
-            --  may lead to use before declaration issues in the case of array
-            --  types.
-
-            when N_Expression_With_Actions =>
-               if Is_List_Member (P)
-                 and then List_Containing (P) = Actions (Parent_P)
-               then
+               --  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
+               --  freeze node before it.
+
+               when N_Block_Statement
+                  | N_Entry_Body
+                  | N_Package_Body
+                  | N_Package_Specification
+                  | N_Protected_Body
+                  | N_Subprogram_Body
+                  | N_Task_Body
+               =>
                   exit;
-               end if;
 
-            --  Note: N_Loop_Statement is a special case. A type that appears
-            --  in the source can never be frozen in a loop (this occurs only
-            --  because of a loop expanded by the expander), so we keep on
-            --  going. Otherwise we terminate the search. Same is true of any
-            --  entity which comes from source. (if they have predefined type,
-            --  that type does not appear to come from source, but the entity
-            --  should not be frozen here).
+               --  The expander is allowed to define types in any statements
+               --  list, so any of the following parent nodes also mark a
+               --  freezing point if the actual node is in a list of
+               --  statements or declarations.
+
+               when N_Abortable_Part
+                  | N_Accept_Alternative
+                  | N_And_Then
+                  | N_Case_Statement_Alternative
+                  | N_Compilation_Unit_Aux
+                  | N_Conditional_Entry_Call
+                  | N_Delay_Alternative
+                  | N_Elsif_Part
+                  | N_Entry_Call_Alternative
+                  | N_Exception_Handler
+                  | N_Extended_Return_Statement
+                  | N_Freeze_Entity
+                  | N_If_Statement
+                  | N_Or_Else
+                  | N_Selective_Accept
+                  | N_Triggering_Alternative
+               =>
+                  exit when Is_List_Member (P);
+
+               --  Freeze nodes produced by an expression coming from the
+               --  Actions list of a N_Expression_With_Actions node must remain
+               --  within the Actions list. Inserting the freeze nodes further
+               --  up the tree may lead to use before declaration issues in the
+               --  case of array types.
+
+               when N_Expression_With_Actions =>
+                  if Is_List_Member (P)
+                    and then List_Containing (P) = Actions (Parent_P)
+                  then
+                     exit;
+                  end if;
 
-            when N_Loop_Statement =>
-               exit when not Comes_From_Source (Etype (N))
-                 and then (No (Nam) or else not Comes_From_Source (Nam));
+               --  Note: N_Loop_Statement is a special case. A type that
+               --  appears in the source can never be frozen in a loop (this
+               --  occurs only because of a loop expanded by the expander), so
+               --  we keep on going. Otherwise we terminate the search. Same
+               --  is true of any entity which comes from source. (if they
+               --  have predefined type, that type does not appear to come
+               --  from source, but the entity should not be frozen here).
 
-            --  For all other cases, keep looking at parents
+               when N_Loop_Statement =>
+                  exit when not Comes_From_Source (Etype (N))
+                    and then (No (Nam) or else not Comes_From_Source (Nam));
 
-            when others =>
-               null;
-         end case;
+               --  For all other cases, keep looking at parents
 
-         --  We fall through the case if we did not yet find the proper
-         --  place in the free for inserting the freeze node, so climb.
+               when others =>
+                  null;
+            end case;
 
-         P := Parent_P;
-      end loop;
+            --  We fall through the case if we did not yet find the proper
+            --  place in the free for inserting the freeze node, so climb.
+
+            P := Parent_P;
+         end loop;
+      end if;
 
       --  If the expression appears in a record or an initialization procedure,
       --  the freeze nodes are collected and attached to the current scope, to

--- gcc/ada/sem_ch3.adb
+++ gcc/ada/sem_ch3.adb
@@ -605,6 +605,10 @@  package body Sem_Ch3 is
    --  Create a new ordinary fixed point type, and apply the constraint to
    --  obtain subtype of it.
 
+   procedure Preanalyze_Default_Expression (N : Node_Id; T : Entity_Id);
+   --  Wrapper on Preanalyze_Spec_Expression for default expressions, so that
+   --  In_Default_Expr can be properly adjusted.
+
    procedure Prepare_Private_Subtype_Completion
      (Id          : Entity_Id;
       Related_Nod : Node_Id);
@@ -19818,11 +19822,14 @@  package body Sem_Ch3 is
    -----------------------------------
 
    procedure Preanalyze_Default_Expression (N : Node_Id; T : Entity_Id) is
-      Save_In_Default_Expr : constant Boolean := In_Default_Expr;
+      Save_In_Default_Expr    : constant Boolean := In_Default_Expr;
+      Save_In_Spec_Expression : constant Boolean := In_Spec_Expression;
    begin
-      In_Default_Expr := True;
-      Preanalyze_Spec_Expression (N, T);
-      In_Default_Expr := Save_In_Default_Expr;
+      In_Default_Expr    := True;
+      In_Spec_Expression := True;
+      Preanalyze_With_Freezing_And_Resolve (N, T);
+      In_Default_Expr    := Save_In_Default_Expr;
+      In_Spec_Expression := Save_In_Spec_Expression;
    end Preanalyze_Default_Expression;
 
    --------------------------------

--- gcc/ada/sem_ch3.ads
+++ gcc/ada/sem_ch3.ads
@@ -250,10 +250,6 @@  package Sem_Ch3 is
    --  Wrapper on Preanalyze_Spec_Expression for assertion expressions, so that
    --  In_Assertion_Expr can be properly adjusted.
 
-   procedure Preanalyze_Default_Expression (N : Node_Id; T : Entity_Id);
-   --  Wrapper on Preanalyze_Spec_Expression for default expressions, so that
-   --  In_Default_Expr can be properly adjusted.
-
    procedure Process_Full_View (N : Node_Id; Full_T, Priv_T : Entity_Id);
    --  Process some semantic actions when the full view of a private type is
    --  encountered and analyzed. The first action is to create the full views

--- gcc/ada/sem_ch6.adb
+++ gcc/ada/sem_ch6.adb
@@ -206,6 +206,10 @@  package body Sem_Ch6 is
    --  Create the declaration for an inequality operator that is implicitly
    --  created by a user-defined equality operator that yields a boolean.
 
+   procedure Preanalyze_Formal_Expression (N : Node_Id; T : Entity_Id);
+   --  Preanalysis of default expressions of subprogram formals. N is the
+   --  expression to be analyzed and T is the expected type.
+
    procedure Set_Formal_Validity (Formal_Id : Entity_Id);
    --  Formal_Id is an formal parameter entity. This procedure deals with
    --  setting the proper validity status for this entity, which depends on
@@ -761,7 +765,7 @@  package body Sem_Ch6 is
                if not Inside_A_Generic then
                   Push_Scope (Def_Id);
                   Install_Formals (Def_Id);
-                  Preanalyze_Spec_Expression (Expr, Typ);
+                  Preanalyze_Formal_Expression (Expr, Typ);
                   Check_Limited_Return (Original_Node (N), Expr, Typ);
                   End_Scope;
                end if;
@@ -3862,12 +3866,14 @@  package body Sem_Ch6 is
       --  If the subprogram has a class-wide clone, build its body as a copy
       --  of the original body, and rewrite body of original subprogram as a
       --  wrapper that calls the clone. If N is a stub, this construction will
-      --  take place when the proper body is analyzed.
+      --  take place when the proper body is analyzed. No action needed if this
+      --  subprogram has been eliminated.
 
       if Present (Spec_Id)
         and then Present (Class_Wide_Clone (Spec_Id))
         and then (Comes_From_Source (N) or else Was_Expression_Function (N))
         and then Nkind (N) /= N_Subprogram_Body_Stub
+        and then not (Expander_Active and then Is_Eliminated (Spec_Id))
       then
          Build_Class_Wide_Clone_Body (Spec_Id, N);
 
@@ -11333,6 +11339,18 @@  package body Sem_Ch6 is
          end if;
    end New_Overloaded_Entity;
 
+   ----------------------------------
+   -- Preanalyze_Formal_Expression --
+   ----------------------------------
+
+   procedure Preanalyze_Formal_Expression (N : Node_Id; T : Entity_Id) is
+      Save_In_Spec_Expression : constant Boolean := In_Spec_Expression;
+   begin
+      In_Spec_Expression := True;
+      Preanalyze_With_Freezing_And_Resolve (N, T);
+      In_Spec_Expression := Save_In_Spec_Expression;
+   end Preanalyze_Formal_Expression;
+
    ---------------------
    -- Process_Formals --
    ---------------------
@@ -11625,7 +11643,7 @@  package body Sem_Ch6 is
             --  Do the special preanalysis of the expression (see section on
             --  "Handling of Default Expressions" in the spec of package Sem).
 
-            Preanalyze_Spec_Expression (Default, Formal_Type);
+            Preanalyze_Formal_Expression (Default, Formal_Type);
 
             --  An access to constant cannot be the default for
             --  an access parameter that is an access to variable.

--- gcc/ada/sem_res.adb
+++ gcc/ada/sem_res.adb
@@ -142,6 +142,12 @@  package body Sem_Res is
    --  a call, so such an operator is not treated as predefined by this
    --  predicate.
 
+   procedure Preanalyze_And_Resolve
+     (N             : Node_Id;
+      T             : Entity_Id;
+      With_Freezing : Boolean);
+   --  Subsidiary of public versions of Preanalyze_And_Resolve.
+
    procedure Replace_Actual_Discriminants (N : Node_Id; Default : Node_Id);
    --  If a default expression in entry call N depends on the discriminants
    --  of the task, it must be replaced with a reference to the discriminant
@@ -1660,10 +1666,21 @@  package body Sem_Res is
    -- Preanalyze_And_Resolve --
    ----------------------------
 
-   procedure Preanalyze_And_Resolve (N : Node_Id; T : Entity_Id) is
-      Save_Full_Analysis : constant Boolean := Full_Analysis;
+   procedure Preanalyze_And_Resolve
+     (N             : Node_Id;
+      T             : Entity_Id;
+      With_Freezing : Boolean)
+   is
+      Save_Full_Analysis   : constant Boolean := Full_Analysis;
+      Save_Must_Not_Freeze : constant Boolean := Must_Not_Freeze (N);
 
    begin
+      pragma Assert (Nkind (N) in N_Subexpr);
+
+      if not With_Freezing then
+         Set_Must_Not_Freeze (N);
+      end if;
+
       Full_Analysis := False;
       Expander_Mode_Save_And_Set (False);
 
@@ -1690,6 +1707,16 @@  package body Sem_Res is
 
       Expander_Mode_Restore;
       Full_Analysis := Save_Full_Analysis;
+      Set_Must_Not_Freeze (N, Save_Must_Not_Freeze);
+   end Preanalyze_And_Resolve;
+
+   ----------------------------
+   -- Preanalyze_And_Resolve --
+   ----------------------------
+
+   procedure Preanalyze_And_Resolve (N : Node_Id; T : Entity_Id) is
+   begin
+      Preanalyze_And_Resolve (N, T, With_Freezing => False);
    end Preanalyze_And_Resolve;
 
    --  Version without context type
@@ -1708,6 +1735,16 @@  package body Sem_Res is
       Full_Analysis := Save_Full_Analysis;
    end Preanalyze_And_Resolve;
 
+   ------------------------------------------
+   -- Preanalyze_With_Freezing_And_Resolve --
+   ------------------------------------------
+
+   procedure Preanalyze_With_Freezing_And_Resolve (N : Node_Id; T : Entity_Id)
+   is
+   begin
+      Preanalyze_And_Resolve (N, T, With_Freezing => True);
+   end Preanalyze_With_Freezing_And_Resolve;
+
    ----------------------------------
    -- Replace_Actual_Discriminants --
    ----------------------------------

--- gcc/ada/sem_res.ads
+++ gcc/ada/sem_res.ads
@@ -93,6 +93,9 @@  package Sem_Res is
    procedure Preanalyze_And_Resolve (N : Node_Id);
    --  Same, but use type of node because context does not impose a single type
 
+   procedure Preanalyze_With_Freezing_And_Resolve (N : Node_Id; T : Entity_Id);
+   --  Same, but perform freezing of static expressions of N or its children.
+
    procedure Resolve (N : Node_Id; Typ : Entity_Id);
    procedure Resolve (N : Node_Id; Typ : Entity_Id; Suppress : Check_Id);
    --  Top-level type-checking procedure, called in a complete context. The