diff options
Diffstat (limited to 'gcc/ada/sem_res.adb')
| -rw-r--r-- | gcc/ada/sem_res.adb | 64 |
1 files changed, 32 insertions, 32 deletions
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index fc95bb8ed2d..ab08e77153b 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -193,7 +193,6 @@ package body Sem_Res is procedure Resolve_Op_Expon (N : Node_Id; Typ : Entity_Id); procedure Resolve_Op_Not (N : Node_Id; Typ : Entity_Id); procedure Resolve_Qualified_Expression (N : Node_Id; Typ : Entity_Id); - procedure Resolve_Quantified_Expression (N : Node_Id; Typ : Entity_Id); procedure Resolve_Range (N : Node_Id; Typ : Entity_Id); procedure Resolve_Real_Literal (N : Node_Id; Typ : Entity_Id); procedure Resolve_Reference (N : Node_Id; Typ : Entity_Id); @@ -1770,6 +1769,10 @@ package body Sem_Res is -- Try and fix up a literal so that it matches its expected type. New -- literals are manufactured if necessary to avoid cascaded errors. + function Proper_Current_Scope return Entity_Id; + -- Return the current scope. Skip loop scopes created for the purpose of + -- quantified expression analysis since those do not appear in the tree. + procedure Report_Ambiguous_Argument; -- Additional diagnostics when an ambiguous call has an ambiguous -- argument (typically a controlling actual). @@ -1832,6 +1835,30 @@ package body Sem_Res is end if; end Patch_Up_Value; + -------------------------- + -- Proper_Current_Scope -- + -------------------------- + + function Proper_Current_Scope return Entity_Id is + S : Entity_Id := Current_Scope; + + begin + while Present (S) loop + + -- Skip a loop scope created for quantified expression analysis + + if Ekind (S) = E_Loop + and then Nkind (Parent (S)) = N_Quantified_Expression + then + S := Scope (S); + else + exit; + end if; + end loop; + + return S; + end Proper_Current_Scope; + ------------------------------- -- Report_Ambiguous_Argument -- ------------------------------- @@ -2761,8 +2788,7 @@ package body Sem_Res is when N_Qualified_Expression => Resolve_Qualified_Expression (N, Ctx_Type); - when N_Quantified_Expression - => Resolve_Quantified_Expression (N, Ctx_Type); + when N_Quantified_Expression => null; when N_Raise_xxx_Error => Set_Etype (N, Ctx_Type); @@ -2857,10 +2883,9 @@ package body Sem_Res is -- Ada 2012 (AI05-177): Expression functions do not freeze. Only -- their use (in an expanded call) freezes. - if Ekind (Current_Scope) /= E_Function - or else - Nkind (Original_Node (Unit_Declaration_Node (Current_Scope))) /= - N_Expression_Function + if Ekind (Proper_Current_Scope) /= E_Function + or else Nkind (Original_Node (Unit_Declaration_Node + (Proper_Current_Scope))) /= N_Expression_Function then Freeze_Expression (N); end if; @@ -8290,31 +8315,6 @@ package body Sem_Res is Eval_Qualified_Expression (N); end Resolve_Qualified_Expression; - ----------------------------------- - -- Resolve_Quantified_Expression -- - ----------------------------------- - - procedure Resolve_Quantified_Expression (N : Node_Id; Typ : Entity_Id) is - begin - if not Alfa_Mode then - - -- The loop structure is already resolved during its analysis, only - -- the resolution of the condition needs to be done. Expansion is - -- disabled so that checks and other generated code are inserted in - -- the tree after expression has been rewritten as a loop. - - Expander_Mode_Save_And_Set (False); - Resolve (Condition (N), Typ); - Expander_Mode_Restore; - - -- In Alfa mode, we need normal expansion in order to properly introduce - -- the necessary transient scopes. - - else - Resolve (Condition (N), Typ); - end if; - end Resolve_Quantified_Expression; - ------------------- -- Resolve_Range -- ------------------- |