diff options
Diffstat (limited to 'gcc/ada')
| -rw-r--r-- | gcc/ada/ChangeLog | 32 | ||||
| -rw-r--r-- | gcc/ada/exp_ch13.adb | 5 | ||||
| -rw-r--r-- | gcc/ada/freeze.adb | 517 | ||||
| -rw-r--r-- | gcc/ada/sem_ch3.adb | 15 | ||||
| -rw-r--r-- | gcc/ada/sem_ch3.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/sem_ch6.adb | 24 | ||||
| -rw-r--r-- | gcc/ada/sem_res.adb | 41 | ||||
| -rw-r--r-- | gcc/ada/sem_res.ads | 3 |
8 files changed, 414 insertions, 227 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index d9d4f24..a207522 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,35 @@ +2018-07-17 Javier Miranda <miranda@adacore.com> + + * 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. + 2018-07-17 Piotr Trojanek <trojanek@adacore.com> * einfo.ads, libgnat/g-comlin.ads: Minor change "ie" to "i.e." in docs diff --git a/gcc/ada/exp_ch13.adb b/gcc/ada/exp_ch13.adb index 89be351..70e9327 100644 --- a/gcc/ada/exp_ch13.adb +++ b/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 diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 3f0350a..691d6a5 100644 --- a/gcc/ada/freeze.adb +++ b/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 diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index fce4992..ad9d7e1 100644 --- a/gcc/ada/sem_ch3.adb +++ b/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; -------------------------------- diff --git a/gcc/ada/sem_ch3.ads b/gcc/ada/sem_ch3.ads index 2e16917..c82ab86 100644 --- a/gcc/ada/sem_ch3.ads +++ b/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 diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 304e35c..08717bf 100644 --- a/gcc/ada/sem_ch6.adb +++ b/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. diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index b2cac71..6bcfc38 100644 --- a/gcc/ada/sem_res.adb +++ b/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 -- ---------------------------------- diff --git a/gcc/ada/sem_res.ads b/gcc/ada/sem_res.ads index 58c8b5e..aeb758d 100644 --- a/gcc/ada/sem_res.ads +++ b/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 |