[gcc r12-2078] [Ada] Warn on statically known empty loop caused by constraint

[gcc r12-2078] [Ada] Warn on statically known empty loop caused by constraint

[Pierre-Marie de Rodat]

https://gcc.gnu.org/g:8ff47b3f88330ae222d393883d6b4a9c5393dc69

commit r12-2078-g8ff47b3f88330ae222d393883d6b4a9c5393dc69
Author: Ghjuvan Lacambre <lacambre@adacore.com>
Date:   Wed May 12 14:43:06 2021 +0200

    [Ada] Warn on statically known empty loop caused by constraint
    
    gcc/ada/
    
            * sem_ch5.adb (Analyze_Loop_Parameter_Specification): Check for
            empty loops caused by constraints.

Diff:
---
 gcc/ada/sem_ch5.adb | 26 ++++++++++++++++++++++++++
 1 file changed, 26 insertions(+)

diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
index 3c98d738297..ccd5a3728c7 100644
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -3377,6 +3377,32 @@ package body Sem_Ch5 is
                        ("\loop executes zero times or raises "
                         & "Constraint_Error??", Bad_Bound);
                   end if;
+
+                  if Compile_Time_Compare (LLo, LHi, Assume_Valid => False)
+                    = GT
+                  then
+                     Error_Msg_N ("??constrained range is null",
+                       Constraint (DS));
+
+                     --  Additional constraints on modular types can be
+                     --  confusing, add more information.
+
+                     if Ekind (Etype (DS)) = E_Modular_Integer_Subtype then
+                        Error_Msg_Uint_1 := Intval (LLo);
+                        Error_Msg_Uint_2 := Intval (LHi);
+                        Error_Msg_NE ("\iterator has modular type &, " &
+                          "so the loop has bounds ^ ..^",
+                          Constraint (DS),
+                          Subtype_Mark (DS));
+                     end if;
+
+                     Set_Is_Null_Loop (Loop_Nod);
+                     Null_Range := True;
+
+                     --  Suppress other warnigns about the body of the loop, as
+                     --  it will never execute.
+                     Set_Suppress_Loop_Warnings (Loop_Nod);
+                  end if;
                end;
             end if;