aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPiotr Trojanek <trojanek@adacore.com>2022-07-18 16:14:55 +0200
committerMarc Poulhiès <poulhies@adacore.com>2022-09-05 09:21:02 +0200
commit7c23b88c1fc2303d7c5c09334f00d10c5456aa53 (patch)
tree11b386598963d8dc2ec9a9b015fd5df885a698d5
parent72c5ce77a028e57048c8666a7b782e3b921ee28c (diff)
downloadgcc-7c23b88c1fc2303d7c5c09334f00d10c5456aa53.zip
gcc-7c23b88c1fc2303d7c5c09334f00d10c5456aa53.tar.gz
gcc-7c23b88c1fc2303d7c5c09334f00d10c5456aa53.tar.bz2
[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.
-rw-r--r--gcc/ada/sem_ch4.adb59
1 files changed, 27 insertions, 32 deletions
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 5497483..ed2f621c 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;