From 7c23b88c1fc2303d7c5c09334f00d10c5456aa53 Mon Sep 17 00:00:00 2001 From: Piotr Trojanek Date: Mon, 18 Jul 2022 16:14:55 +0200 Subject: [PATCH] [Ada] Cleanup analysis of quantified expressions with empty ranges Cleanup handling of quantified expressions before using it as an inspiration for fixing the handling of iterated component associations. Behavior is unaffected. gcc/ada/ * sem_ch4.adb (Is_Empty_Range): Move error reporting to the caller. (Analyze_Qualified_Expression): Move error reporting from Is_Empty_Range; add matching call to End_Scope before rewriting and returning. --- gcc/ada/sem_ch4.adb | 59 +++++++++++++++++++++------------------------ 1 file changed, 27 insertions(+), 32 deletions(-) diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 54974832c394..ed2f621c9d95 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -4394,9 +4394,8 @@ package body Sem_Ch4 is procedure Analyze_Quantified_Expression (N : Node_Id) is function Is_Empty_Range (Typ : Entity_Id) return Boolean; - -- If the iterator is part of a quantified expression, and the range is - -- known to be statically empty, emit a warning and replace expression - -- with its static value. Returns True if the replacement occurs. + -- Return True if the iterator is part of a quantified expression and + -- the range is known to be statically empty. function No_Else_Or_Trivial_True (If_Expr : Node_Id) return Boolean; -- Determine whether if expression If_Expr lacks an else part or if it @@ -4407,36 +4406,12 @@ package body Sem_Ch4 is -------------------- function Is_Empty_Range (Typ : Entity_Id) return Boolean is - Loc : constant Source_Ptr := Sloc (N); - begin - if Is_Array_Type (Typ) + return Is_Array_Type (Typ) and then Compile_Time_Known_Bounds (Typ) and then - (Expr_Value (Type_Low_Bound (Etype (First_Index (Typ)))) > - Expr_Value (Type_High_Bound (Etype (First_Index (Typ))))) - then - Preanalyze_And_Resolve (Condition (N), Standard_Boolean); - - if All_Present (N) then - Error_Msg_N - ("??quantified expression with ALL " - & "over a null range has value True", N); - Rewrite (N, New_Occurrence_Of (Standard_True, Loc)); - - else - Error_Msg_N - ("??quantified expression with SOME " - & "over a null range has value False", N); - Rewrite (N, New_Occurrence_Of (Standard_False, Loc)); - end if; - - Analyze (N); - return True; - - else - return False; - end if; + Expr_Value (Type_Low_Bound (Etype (First_Index (Typ)))) > + Expr_Value (Type_High_Bound (Etype (First_Index (Typ)))); end Is_Empty_Range; ----------------------------- @@ -4456,6 +4431,7 @@ package body Sem_Ch4 is -- Local variables Cond : constant Node_Id := Condition (N); + Loc : constant Source_Ptr := Sloc (N); Loop_Id : Entity_Id; QE_Scop : Entity_Id; @@ -4466,7 +4442,7 @@ package body Sem_Ch4 is -- expression. The scope is needed to provide proper visibility of the -- loop variable. - QE_Scop := New_Internal_Entity (E_Loop, Current_Scope, Sloc (N), 'L'); + QE_Scop := New_Internal_Entity (E_Loop, Current_Scope, Loc, 'L'); Set_Etype (QE_Scop, Standard_Void_Type); Set_Scope (QE_Scop, Current_Scope); Set_Parent (QE_Scop, N); @@ -4482,11 +4458,30 @@ package body Sem_Ch4 is Preanalyze (Iterator_Specification (N)); -- Do not proceed with the analysis when the range of iteration is - -- empty. The appropriate error is issued by Is_Empty_Range. + -- empty. if Is_Entity_Name (Name (Iterator_Specification (N))) and then Is_Empty_Range (Etype (Name (Iterator_Specification (N)))) then + Preanalyze_And_Resolve (Condition (N), Standard_Boolean); + End_Scope; + + -- Emit a warning and replace expression with its static value + + if All_Present (N) then + Error_Msg_N + ("??quantified expression with ALL " + & "over a null range has value True", N); + Rewrite (N, New_Occurrence_Of (Standard_True, Loc)); + + else + Error_Msg_N + ("??quantified expression with SOME " + & "over a null range has value False", N); + Rewrite (N, New_Occurrence_Of (Standard_False, Loc)); + end if; + + Analyze (N); return; end if; -- 2.47.2