[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.

diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 54974832c3949e5fd0c154b1f0a83831ab75cb20..ed2f621c9d9519712ca3bfc31796fb516daa2fc3 100644 (file)
--- 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;