checks.adb (Determine_Range): Add Assume_Valid parameter

2009-04-07  Robert Dewar  <dewar@adacore.com>

	* checks.adb (Determine_Range): Add Assume_Valid parameter
	
	* checks.ads (Determine_Range): Add Assume_Valid parameter
	
	* errout.adb (Error_Msg_NEL): Use Suppress_Loop_Warnings rather than
	 Is_Null_Loop to suppress warnings in a loop body.
	
	* exp_ch4.adb:
	(Rewrite_Comparison): Major rewrite to accomodate invalid values
	
	* exp_ch5.adb:
	(Expand_N_Loop_Statement): Delete loop known not to execute
	
	* opt.ads:
	(Assume_No_Invalid_Values): Now set to False, and as documented, this
	 fully enables the proper handling of invalid values.
	
	* sem_attr.adb:
	New calling sequence for Is_In_Range
	
	* sem_ch5.adb:
	(Analyze_Iteration_Scheme): Accomodate possible invalid values
	 in determining if a loop range is null.
	
	* sem_eval.adb:
	(Is_In_Range): Add Assume_Valid parameter
	(Is_Out_Of_Range): Add Assume_Valid_Parameter
	(Compile_Time_Compare): Major rewrite to accomodate invalid values and
	 also to do more accurate and complete range analysis, catching more
	 cases.
	
	* sem_eval.ads:
	(Is_In_Range): Add Assume_Valid parameter
	(Is_Out_Of_Range): Add Assume_Valid_Parameter
	
	* sem_util.adb:
	New calling sequence for Is_In_Range
	
	* sinfo.adb:
	(Suppress_Loop_Warnings): New flag
	
	* sinfo.ads:
	(Is_Null_Loop): Update documentation
	(Suppress_Loop_Warnings): New flag
	
	* gnat_ugn.texi: Document -gnatB switch

From-SVN: r145672

15 files changed, 483 insertions, 162 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 16250a8..c031027 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,52 @@
+2009-04-07  Robert Dewar  <dewar@adacore.com>
+
+	* checks.adb (Determine_Range): Add Assume_Valid parameter
+	
+	* checks.ads (Determine_Range): Add Assume_Valid parameter
+	
+	* errout.adb (Error_Msg_NEL): Use Suppress_Loop_Warnings rather than
+	 Is_Null_Loop to suppress warnings in a loop body.
+	
+	* exp_ch4.adb:
+	(Rewrite_Comparison): Major rewrite to accomodate invalid values
+	
+	* exp_ch5.adb:
+	(Expand_N_Loop_Statement): Delete loop known not to execute
+	
+	* opt.ads:
+	(Assume_No_Invalid_Values): Now set to False, and as documented, this
+	 fully enables the proper handling of invalid values.
+	
+	* sem_attr.adb:
+	New calling sequence for Is_In_Range
+	
+	* sem_ch5.adb:
+	(Analyze_Iteration_Scheme): Accomodate possible invalid values
+	 in determining if a loop range is null.
+	
+	* sem_eval.adb:
+	(Is_In_Range): Add Assume_Valid parameter
+	(Is_Out_Of_Range): Add Assume_Valid_Parameter
+	(Compile_Time_Compare): Major rewrite to accomodate invalid values and
+	 also to do more accurate and complete range analysis, catching more
+	 cases.
+	
+	* sem_eval.ads:
+	(Is_In_Range): Add Assume_Valid parameter
+	(Is_Out_Of_Range): Add Assume_Valid_Parameter
+	
+	* sem_util.adb:
+	New calling sequence for Is_In_Range
+	
+	* sinfo.adb:
+	(Suppress_Loop_Warnings): New flag
+	
+	* sinfo.ads:
+	(Is_Null_Loop): Update documentation
+	(Suppress_Loop_Warnings): New flag
+	
+	* gnat_ugn.texi: Document -gnatB switch
+
 2009-04-07  Arnaud Charlet  <charlet@adacore.com>
 
 	* gnatvsn.ads: Bump version number.
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index 92b66f3..ab5c868 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -842,14 +842,16 @@ package body Checks is
                Tlo := Expr_Value (Type_Low_Bound  (Target_Type));
                Thi := Expr_Value (Type_High_Bound (Target_Type));
 
-               Determine_Range (Left_Opnd  (N), LOK, Llo, Lhi);
-               Determine_Range (Right_Opnd (N), ROK, Rlo, Rhi);
+               Determine_Range
+                 (Left_Opnd  (N), LOK, Llo, Lhi, Assume_Valid => True);
+               Determine_Range
+                 (Right_Opnd (N), ROK, Rlo, Rhi, Assume_Valid => True);
 
                if (LOK and ROK)
                  and then Tlo <= Llo and then Lhi <= Thi
                  and then Tlo <= Rlo and then Rhi <= Thi
                then
-                  Determine_Range (N, VOK, Vlo, Vhi);
+                  Determine_Range (N, VOK, Vlo, Vhi, Assume_Valid => True);
 
                   if VOK and then Tlo <= Vlo and then Vhi <= Thi then
                      Rewrite (Left_Opnd (N),
@@ -1459,7 +1461,7 @@ package body Checks is
         and then not Backend_Divide_Checks_On_Target
         and then Check_Needed (Right, Division_Check)
       then
-         Determine_Range (Right, ROK, Rlo, Rhi);
+         Determine_Range (Right, ROK, Rlo, Rhi, Assume_Valid => True);
 
          --  See if division by zero possible, and if so generate test. This
          --  part of the test is not controlled by the -gnato switch.
@@ -1482,7 +1484,7 @@ package body Checks is
             if Nkind (N) = N_Op_Divide
               and then Is_Signed_Integer_Type (Typ)
             then
-               Determine_Range (Left, LOK, Llo, Lhi);
+               Determine_Range (Left, LOK, Llo, Lhi, Assume_Valid => True);
                LLB := Expr_Value (Type_Low_Bound (Base_Type (Typ)));
 
                if ((not ROK) or else (Rlo <= (-1) and then (-1) <= Rhi))
@@ -2003,7 +2005,7 @@ package body Checks is
 
                   --  Otherwise determine range of value
 
-                  Determine_Range (Expr, OK, Lo, Hi);
+                  Determine_Range (Expr, OK, Lo, Hi, Assume_Valid => True);
 
                   if OK then
 
@@ -2046,11 +2048,18 @@ package body Checks is
                            Assume_Valid => True,
                            Fixed_Int    => Fixed_Int)
              or else
-           Is_In_Range (Expr, Target_Typ, Fixed_Int, Int_Real))
+               Is_In_Range (Expr, Target_Typ,
+                            Assume_Valid => True,
+                            Fixed_Int => Fixed_Int,
+                            Int_Real  => Int_Real))
       then
          return;
 
-      elsif Is_Out_Of_Range (Expr, Target_Typ, Fixed_Int, Int_Real) then
+      elsif Is_Out_Of_Range (Expr, Target_Typ,
+                             Assume_Valid => True,
+                             Fixed_Int    => Fixed_Int,
+                             Int_Real     => Int_Real)
+      then
          Bad_Value;
          return;
 
@@ -3010,6 +3019,7 @@ package body Checks is
    --  Determine size of below cache (power of 2 is more efficient!)
 
    Determine_Range_Cache_N  : array (Cache_Index) of Node_Id;
+   Determine_Range_Cache_V  : array (Cache_Index) of Boolean;
    Determine_Range_Cache_Lo : array (Cache_Index) of Uint;
    Determine_Range_Cache_Hi : array (Cache_Index) of Uint;
    --  The above arrays are used to implement a small direct cache for
@@ -3018,13 +3028,15 @@ package body Checks is
    --  on the way up the tree, a quadratic behavior can otherwise be
    --  encountered in large expressions. The cache entry for node N is stored
    --  in the (N mod Cache_Size) entry, and can be validated by checking the
-   --  actual node value stored there.
+   --  actual node value stored there. The Range_Cache_V array records the
+   --  setting of Assume_Valid for the cache entry.
 
    procedure Determine_Range
-     (N  : Node_Id;
-      OK : out Boolean;
-      Lo : out Uint;
-      Hi : out Uint)
+     (N            : Node_Id;
+      OK           : out Boolean;
+      Lo           : out Uint;
+      Hi           : out Uint;
+      Assume_Valid : Boolean := False)
    is
       Typ : Entity_Id := Etype (N);
       --  Type to use, may get reset to base type for possibly invalid entity
@@ -3064,13 +3076,15 @@ package body Checks is
 
       function OK_Operands return Boolean is
       begin
-         Determine_Range (Left_Opnd  (N), OK1, Lo_Left,  Hi_Left);
+         Determine_Range
+           (Left_Opnd  (N), OK1, Lo_Left,  Hi_Left, Assume_Valid);
 
          if not OK1 then
             return False;
          end if;
 
-         Determine_Range (Right_Opnd (N), OK1, Lo_Right, Hi_Right);
+         Determine_Range
+           (Right_Opnd (N), OK1, Lo_Right, Hi_Right, Assume_Valid);
          return OK1;
       end OK_Operands;
 
@@ -3111,7 +3125,10 @@ package body Checks is
 
       Cindex := Cache_Index (N mod Cache_Size);
 
-      if Determine_Range_Cache_N (Cindex) = N then
+      if Determine_Range_Cache_N (Cindex) = N
+           and then
+         Determine_Range_Cache_V (Cindex) = Assume_Valid
+      then
          Lo := Determine_Range_Cache_Lo (Cindex);
          Hi := Determine_Range_Cache_Hi (Cindex);
          return;
@@ -3122,14 +3139,15 @@ package body Checks is
       --  overflow situation, which is a separate check, we are talking here
       --  only about the expression value).
 
-      --  First step, change to use base type if the expression is an entity
-      --  which we do not know is valid.
+      --  First step, change to use base type unless we know the value is valid
 
-      if Is_Entity_Name (N)
-        and then not Is_Known_Valid (Entity (N))
-        and then not Assume_No_Invalid_Values
+      if (Is_Entity_Name (N) and then Is_Known_Valid (Entity (N)))
+        or else Assume_No_Invalid_Values
+        or else Assume_Valid
       then
-         Typ := Base_Type (Typ);
+         null;
+      else
+         Typ := Underlying_Type (Base_Type (Typ));
       end if;
 
       --  We use the actual bound unless it is dynamic, in which case use the
@@ -3186,12 +3204,14 @@ package body Checks is
          --  For unary plus, result is limited by range of operand
 
          when N_Op_Plus =>
-            Determine_Range (Right_Opnd (N), OK1, Lor, Hir);
+            Determine_Range
+              (Right_Opnd (N), OK1, Lor, Hir, Assume_Valid);
 
          --  For unary minus, determine range of operand, and negate it
 
          when N_Op_Minus =>
-            Determine_Range (Right_Opnd (N), OK1, Lo_Right, Hi_Right);
+            Determine_Range
+              (Right_Opnd (N), OK1, Lo_Right, Hi_Right, Assume_Valid);
 
             if OK1 then
                Lor := -Hi_Right;
@@ -3298,7 +3318,8 @@ package body Checks is
                --  possible range of values of the attribute expression
 
                when Name_Pos | Name_Val =>
-                  Determine_Range (First (Expressions (N)), OK1, Lor, Hir);
+                  Determine_Range
+                    (First (Expressions (N)), OK1, Lor, Hir, Assume_Valid);
 
                --  For Length attribute, use the bounds of the corresponding
                --  index type to refine the range.
@@ -3341,11 +3362,13 @@ package body Checks is
                      end loop;
 
                      Determine_Range
-                       (Type_Low_Bound (Etype (Indx)), OK1, LL, LU);
+                       (Type_Low_Bound (Etype (Indx)), OK1, LL, LU,
+                        Assume_Valid);
 
                      if OK1 then
                         Determine_Range
-                          (Type_High_Bound (Etype (Indx)), OK1, UL, UU);
+                          (Type_High_Bound (Etype (Indx)), OK1, UL, UU,
+                           Assume_Valid);
 
                         if OK1 then
 
@@ -3353,7 +3376,7 @@ package body Checks is
                            --  possible gap between the values of the bounds.
                            --  But of course, this value cannot be negative.
 
-                           Hir := UI_Max (Uint_0, UU - LL);
+                           Hir := UI_Max (Uint_0, UU - LL + 1);
 
                            --  For constrained arrays, the minimum value for
                            --  Length is taken from the actual value of the
@@ -3361,7 +3384,7 @@ package body Checks is
                            --  this subtype.
 
                            if Is_Constrained (Atyp) then
-                              Lor := UI_Max (Uint_0, UL - LU);
+                              Lor := UI_Max (Uint_0, UL - LU + 1);
 
                            --  For an unconstrained array, the minimum value
                            --  for length is always zero.
@@ -3385,7 +3408,7 @@ package body Checks is
          --  refine the range using the converted value.
 
          when N_Type_Conversion =>
-            Determine_Range (Expression (N), OK1, Lor, Hir);
+            Determine_Range (Expression (N), OK1, Lor, Hir, Assume_Valid);
 
          --  Nothing special to do for all other expression kinds
 
@@ -3430,6 +3453,7 @@ package body Checks is
       --  Set cache entry for future call and we are all done
 
       Determine_Range_Cache_N  (Cindex) := N;
+      Determine_Range_Cache_V  (Cindex) := Assume_Valid;
       Determine_Range_Cache_Lo (Cindex) := Lo;
       Determine_Range_Cache_Hi (Cindex) := Hi;
       return;
@@ -3546,7 +3570,7 @@ package body Checks is
       --  different.
 
       if Nkind (N) /= N_Type_Conversion then
-         Determine_Range (N, OK, Lo, Hi);
+         Determine_Range (N, OK, Lo, Hi, Assume_Valid => True);
 
          --  Note in the test below that we assume that the range is not OK
          --  if a bound of the range is equal to that of the type. That's not
@@ -6954,7 +6978,6 @@ package body Checks is
                begin
                   Opnd_Index := First_Index (Get_Actual_Subtype (Ck_Node));
                   Targ_Index := First_Index (T_Typ);
-
                   while Present (Opnd_Index) loop
 
                      --  If the index is a range, use its bounds. If it is an
@@ -6970,11 +6993,13 @@ package body Checks is
                      end if;
 
                      if Nkind (Opnd_Range) = N_Range then
-                        if Is_In_Range
-                             (Low_Bound (Opnd_Range), Etype (Targ_Index))
+                        if  Is_In_Range
+                             (Low_Bound (Opnd_Range), Etype (Targ_Index),
+                              Assume_Valid => True)
                           and then
                             Is_In_Range
-                             (High_Bound (Opnd_Range), Etype (Targ_Index))
+                             (High_Bound (Opnd_Range), Etype (Targ_Index),
+                              Assume_Valid => True)
                         then
                            null;
 
@@ -6991,10 +7016,12 @@ package body Checks is
                            null;
 
                         elsif Is_Out_Of_Range
-                                (Low_Bound (Opnd_Range), Etype (Targ_Index))
+                                (Low_Bound (Opnd_Range), Etype (Targ_Index),
+                                 Assume_Valid => True)
                           or else
                               Is_Out_Of_Range
-                                (High_Bound (Opnd_Range), Etype (Targ_Index))
+                                (High_Bound (Opnd_Range), Etype (Targ_Index),
+                                 Assume_Valid => True)
                         then
                            Add_Check
                              (Compile_Time_Constraint_Error
diff --git a/gcc/ada/checks.ads b/gcc/ada/checks.ads
index 4a72102..1b88dc1 100644
--- a/gcc/ada/checks.ads
+++ b/gcc/ada/checks.ads
@@ -184,10 +184,11 @@ package Checks is
    --  to make sure that the universal result is in range.
 
    procedure Determine_Range
-     (N  : Node_Id;
-      OK : out Boolean;
-      Lo : out Uint;
-      Hi : out Uint);
+     (N            : Node_Id;
+      OK           : out Boolean;
+      Lo           : out Uint;
+      Hi           : out Uint;
+      Assume_Valid : Boolean := False);
    --  N is a node for a subexpression. If N is of a discrete type with no
    --  error indications, and no other peculiarities (e.g. missing type
    --  fields), then OK is True on return, and Lo and Hi are set to a
@@ -197,7 +198,10 @@ package Checks is
    --  type, or some kind of error condition is detected, then OK is False on
    --  exit, and Lo/Hi are set to No_Uint. Thus the significance of OK being
    --  False on return is that no useful information is available on the range
-   --  of the expression.
+   --  of the expression. Assume_Valid determines whether the processing is
+   --  allowed to assume that values are in range of their subtypes. If it is
+   --  set to True, then this assumption is valid, if False, then processing
+   --  is done using base types to allow invalid values.
 
    procedure Install_Null_Excluding_Check (N : Node_Id);
    --  Determines whether an access node requires a runtime access check and
diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb
index 8d1a2c1..6f122f6 100644
--- a/gcc/ada/errout.adb
+++ b/gcc/ada/errout.adb
@@ -1090,7 +1090,9 @@ package body Errout is
             return;
          end if;
 
-         --  Suppress if inside loop that is known to be null
+         --  Suppress if inside loop that is known to be null or is probably
+         --  null (case where loop executes only if invalid values present).
+         --  In either case warnings in the loop are likely to be junk.
 
          declare
             P : Node_Id;
@@ -1098,7 +1100,9 @@ package body Errout is
          begin
             P := Parent (N);
             while Present (P) loop
-               if Nkind (P) = N_Loop_Statement and then Is_Null_Loop (P) then
+               if Nkind (P) = N_Loop_Statement
+                 and then Suppress_Loop_Warnings (P)
+               then
                   return;
                end if;
 
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 9309c48..f924214 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -3826,16 +3826,17 @@ package body Exp_Ch4 is
             Lo_Orig : constant Node_Id := Original_Node (Lo);
             Hi_Orig : constant Node_Id := Original_Node (Hi);
 
-            Lcheck : constant Compare_Result :=
-                       Compile_Time_Compare (Lop, Lo, Assume_Valid => True);
-            Ucheck : constant Compare_Result :=
-                       Compile_Time_Compare (Lop, Hi, Assume_Valid => True);
+            Lcheck : Compare_Result;
+            Ucheck : Compare_Result;
 
             Warn1 : constant Boolean :=
                       Constant_Condition_Warnings
-                        and then Comes_From_Source (N);
+                        and then Comes_From_Source (N)
+                        and then not In_Instance;
             --  This must be true for any of the optimization warnings, we
             --  clearly want to give them only for source with the flag on.
+            --  We also skip these warnings in an instance since it may be
+            --  the case that different instantiations have different ranges.
 
             Warn2 : constant Boolean :=
                       Warn1
@@ -3893,12 +3894,15 @@ package body Exp_Ch4 is
             --  If we have an explicit range, do a bit of optimization based
             --  on range analysis (we may be able to kill one or both checks).
 
+            Lcheck := Compile_Time_Compare (Lop, Lo, Assume_Valid => False);
+            Ucheck := Compile_Time_Compare (Lop, Hi, Assume_Valid => False);
+
             --  If either check is known to fail, replace result by False since
             --  the other check does not matter. Preserve the static flag for
             --  legality checks, because we are constant-folding beyond RM 4.9.
 
             if Lcheck = LT or else Ucheck = GT then
-               if Warn1 and then not In_Instance then
+               if Warn1 then
                   Error_Msg_N ("?range test optimized away", N);
                   Error_Msg_N ("\?value is known to be out of range", N);
                end if;
@@ -3914,7 +3918,7 @@ package body Exp_Ch4 is
             --  since we know we are in range.
 
             elsif Lcheck in Compare_GE and then Ucheck in Compare_LE then
-               if Warn1 and then not In_Instance then
+               if Warn1 then
                   Error_Msg_N ("?range test optimized away", N);
                   Error_Msg_N ("\?value is known to be in range", N);
                end if;
@@ -3962,6 +3966,41 @@ package body Exp_Ch4 is
 
                return;
             end if;
+
+            --  We couldn't optimize away the range check, but there is one
+            --  more issue. If we are checking constant conditionals, then we
+            --  see if we can determine the outcome assuming everything is
+            --  valid, and if so give an appropriate warning.
+
+            if Warn1 and then not Assume_No_Invalid_Values then
+               Lcheck := Compile_Time_Compare (Lop, Lo, Assume_Valid => True);
+               Ucheck := Compile_Time_Compare (Lop, Hi, Assume_Valid => True);
+
+               --  Result is out of range for valid value
+
+               if Lcheck = LT or else Ucheck = GT then
+                  Error_Msg_N
+                    ("?value can only be in range if it is invalid", N);
+
+               --  Result is in range for valid value
+
+               elsif Lcheck in Compare_GE and then Ucheck in Compare_LE then
+                  Error_Msg_N
+                    ("?value can only be out of range if it is invalid", N);
+
+               --  Lower bound check succeeds if value is valid
+
+               elsif Warn2 and then Lcheck in Compare_GE then
+                  Error_Msg_N
+                    ("?lower bound check only fails if it is invalid", Lo);
+
+               --  Upper bound  check succeeds if value is valid
+
+               elsif Warn2 and then Ucheck in Compare_LE then
+                  Error_Msg_N
+                    ("?upper bound check only fails for invalid values", Hi);
+               end if;
+            end if;
          end;
 
          --  For all other cases of an explicit range, nothing to be done
@@ -3998,7 +4037,8 @@ package body Exp_Ch4 is
 
             --  If type is scalar type, rewrite as x in t'first .. t'last.
             --  This reason we do this is that the bounds may have the wrong
-            --  type if they come from the original type definition.
+            --  type if they come from the original type definition. Also this
+            --  way we get all the processing above for an explicit range.
 
             elsif Is_Scalar_Type (Typ) then
                Rewrite (Rop,
@@ -9013,6 +9053,13 @@ package body Exp_Ch4 is
    ------------------------
 
    procedure Rewrite_Comparison (N : Node_Id) is
+      Warning_Generated : Boolean := False;
+      --  Set to True if first pass with Assume_Valid generates a warning in
+      --  which case we skip the second pass to avoid warning overloaded.
+
+      Result : Node_Id;
+      --  Set to Standard_True or Standard_False
+
    begin
       if Nkind (N) = N_Type_Conversion then
          Rewrite_Comparison (Expression (N));
@@ -9022,20 +9069,29 @@ package body Exp_Ch4 is
          return;
       end if;
 
-      declare
-         Typ : constant Entity_Id := Etype (N);
-         Op1 : constant Node_Id   := Left_Opnd (N);
-         Op2 : constant Node_Id   := Right_Opnd (N);
+      --  Now start looking at the comparison in detail. We potentially go
+      --  through this loop twice. The first time, Assume_Valid is set False
+      --  in the call to Compile_Time_Compare. If this call results in a
+      --  clear result of always True or Always False, that's decisive and
+      --  we are done. Otherwise we repeat the processing with Assume_Valid
+      --  set to True to generate additional warnings. We can stil that step
+      --  if Constant_Condition_Warnings is False.
+
+      for AV in False .. True loop
+         declare
+            Typ : constant Entity_Id := Etype (N);
+            Op1 : constant Node_Id   := Left_Opnd (N);
+            Op2 : constant Node_Id   := Right_Opnd (N);
 
-         Res : constant Compare_Result :=
-                 Compile_Time_Compare (Op1, Op2, Assume_Valid => True);
-         --  Res indicates if compare outcome can be compile time determined
+            Res : constant Compare_Result :=
+                    Compile_Time_Compare (Op1, Op2, Assume_Valid => AV);
+            --  Res indicates if compare outcome can be compile time determined
 
-         True_Result  : Boolean;
-         False_Result : Boolean;
+            True_Result  : Boolean;
+            False_Result : Boolean;
 
-      begin
-         case N_Op_Compare (Nkind (N)) is
+         begin
+            case N_Op_Compare (Nkind (N)) is
             when N_Op_Eq =>
                True_Result  := Res = EQ;
                False_Result := Res = LT or else Res = GT or else Res = NE;
@@ -9054,6 +9110,7 @@ package body Exp_Ch4 is
                then
                   Error_Msg_N
                     ("can never be greater than, could replace by ""'=""?", N);
+                  Warning_Generated := True;
                end if;
 
             when N_Op_Gt =>
@@ -9078,28 +9135,62 @@ package body Exp_Ch4 is
                then
                   Error_Msg_N
                     ("can never be less than, could replace by ""'=""?", N);
+                  Warning_Generated := True;
                end if;
 
             when N_Op_Ne =>
                True_Result  := Res = NE or else Res = GT or else Res = LT;
                False_Result := Res = EQ;
-         end case;
+            end case;
 
-         if True_Result then
-            Rewrite (N,
-              Convert_To (Typ,
-                New_Occurrence_Of (Standard_True, Sloc (N))));
-            Analyze_And_Resolve (N, Typ);
-            Warn_On_Known_Condition (N);
+            --  If this is the first iteration, then we actually convert the
+            --  comparison into True or False, if the result is certain.
 
-         elsif False_Result then
-            Rewrite (N,
-              Convert_To (Typ,
-                New_Occurrence_Of (Standard_False, Sloc (N))));
-            Analyze_And_Resolve (N, Typ);
-            Warn_On_Known_Condition (N);
-         end if;
-      end;
+            if AV = False then
+               if True_Result or False_Result then
+                  if True_Result then
+                     Result := Standard_True;
+                  else
+                     Result := Standard_False;
+                  end if;
+
+                  Rewrite (N,
+                    Convert_To (Typ,
+                      New_Occurrence_Of (Result, Sloc (N))));
+                  Analyze_And_Resolve (N, Typ);
+                  Warn_On_Known_Condition (N);
+                  return;
+               end if;
+
+            --  If this is the second iteration (AV = True), and the original
+            --  node comes from source and we are not in an instance, then
+            --  give a warning if we know result would be True or False. Note
+            --  we know Constant_Condition_Warnings is set if we get here.
+
+            elsif Comes_From_Source (Original_Node (N))
+              and then not In_Instance
+            then
+               if True_Result then
+                  Error_Msg_N
+                    ("condition can only be False if invalid values present?",
+                     N);
+               elsif False_Result then
+                  Error_Msg_N
+                    ("condition can only be True if invalid values present?",
+                     N);
+               end if;
+            end if;
+         end;
+
+         --  Skip second iteration if not warning on constant conditions or
+         --  if the first iteration already generated a warning of some kind
+         --  or if we are in any case assuming all values are valid (so that
+         --  the first iteration took care of the valid case).
+
+         exit when not Constant_Condition_Warnings;
+         exit when Warning_Generated;
+         exit when Assume_No_Invalid_Values;
+      end loop;
    end Rewrite_Comparison;
 
    ----------------------------
diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb
index d1c9d88..4305887 100644
--- a/gcc/ada/exp_ch5.adb
+++ b/gcc/ada/exp_ch5.adb
@@ -3306,20 +3306,32 @@ package body Exp_Ch5 is
    -- Expand_N_Loop_Statement --
    -----------------------------
 
-   --  1. Deal with while condition for C/Fortran boolean
-   --  2. Deal with loops with a non-standard enumeration type range
-   --  3. Deal with while loops where Condition_Actions is set
-   --  4. Insert polling call if required
+   --  1. Remove null loop entirely
+   --  2. Deal with while condition for C/Fortran boolean
+   --  3. Deal with loops with a non-standard enumeration type range
+   --  4. Deal with while loops where Condition_Actions is set
+   --  5. Insert polling call if required
 
    procedure Expand_N_Loop_Statement (N : Node_Id) is
       Loc  : constant Source_Ptr := Sloc (N);
       Isc  : constant Node_Id    := Iteration_Scheme (N);
 
    begin
+      --  Delete null loop
+
+      if Is_Null_Loop (N) then
+         Rewrite (N, Make_Null_Statement (Loc));
+         return;
+      end if;
+
+      --  Deal with condition for C/Fortran Boolean
+
       if Present (Isc) then
          Adjust_Condition (Condition (Isc));
       end if;
 
+      --  Generate polling call
+
       if Is_Non_Empty_List (Statements (N)) then
          Generate_Poll_Call (First (Statements (N)));
       end if;
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index 76e5758..78cca28 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -3867,6 +3867,10 @@ it will be ignored.
 @cindex @option{-gnatb} (@command{gcc})
 Generate brief messages to @file{stderr} even if verbose mode set.
 
+@item -gnatB
+@cindex @option{-gnatB} (@command{gcc})
+Assume no invalid (bad) values except for 'Valid attribute use.
+
 @item -gnatc
 @cindex @option{-gnatc} (@command{gcc})
 Check syntax and semantics only (no code generation attempted).
@@ -5586,6 +5590,12 @@ statements (where a wild jump might result from an invalid value),
 and subscripts on the left hand side (where memory corruption could
 occur as a result of an invalid value).
 
+The @option{-gnatB} switch tells the compiler to assume that all
+values are valid (that is, within their declared subtype range)
+except in the context of a use of the Valid attribute. This means
+the compiler can generate more efficient code, since the range
+of values is better known at compile time.
+
 The @option{-gnatV^@var{x}^^} switch allows more control over the validity
 checking mode.
 @ifclear vms
diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads
index 12b6ace..810f4d5 100644
--- a/gcc/ada/opt.ads
+++ b/gcc/ada/opt.ads
@@ -158,14 +158,14 @@ package Opt is
    --  GNAT
    --  Enable assertions made using pragma Assert
 
-   Assume_No_Invalid_Values : Boolean := True;
-   --  ??? true for now, enable by setting to false later
+   Assume_No_Invalid_Values : Boolean := False;
    --  GNAT
    --  Normally, in accordance with (RM 13.9.1 (9-11)) the front end assumes
    --  that values could have invalid representations, unless it can clearly
    --  prove that the values are valid. If this switch is set (by -gnatB or by
    --  pragma Assume_No_Invalid_Values (Off)), then the compiler assumes values
-   --  are valid and in range of their representations.
+   --  are valid and in range of their representations. This feature is now
+   --  fully enabled in the compiler.
 
    Back_Annotate_Rep_Info : Boolean := False;
    --  GNAT
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 6a77fd1..fd72ba0 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -4840,7 +4840,7 @@ package body Sem_Attr is
 
          --  Check that result is in bounds of the type if it is static
 
-         if Is_In_Range (N, T) then
+         if Is_In_Range (N, T, Assume_Valid => False) then
             null;
 
          elsif Is_Out_Of_Range (N, T) then
diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
index a26d4b7..888ac02 100644
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -1843,23 +1843,12 @@ package body Sem_Ch5 is
                         L : constant Node_Id := Low_Bound  (DS);
                         H : constant Node_Id := High_Bound (DS);
 
-                        Llo : Uint;
-                        Lhi : Uint;
-                        LOK : Boolean;
-                        Hlo : Uint;
-                        Hhi : Uint;
-                        HOK : Boolean;
-
-                        pragma Warnings (Off, Hlo);
-
                      begin
-                        Determine_Range (L, LOK, Llo, Lhi);
-                        Determine_Range (H, HOK, Hlo, Hhi);
-
                         --  If range of loop is null, issue warning
 
-                        if (LOK and HOK) and then Llo > Hhi then
-
+                        if Compile_Time_Compare
+                            (L, H, Assume_Valid => True) = GT
+                        then
                            --  Suppress the warning if inside a generic
                            --  template or instance, since in practice
                            --  they tend to be dubious in these cases since
@@ -1868,21 +1857,46 @@ package body Sem_Ch5 is
                            if not Inside_A_Generic
                               and then not In_Instance
                            then
-                              Error_Msg_N
-                                ("?loop range is null, loop will not execute",
-                                 DS);
+                              --  Specialize msg if invalid values could make
+                              --  the loop non-null after all.
+
+                              if Compile_Time_Compare
+                                   (L, H, Assume_Valid => False) = GT
+                              then
+                                 Error_Msg_N
+                                   ("?loop range is null, "
+                                    & "loop will not execute",
+                                    DS);
+
+                                 --  Since we know the range of the loop is
+                                 --  null, set the appropriate flag to remove
+                                 --  the loop entirely during expansion.
+
+                                 Set_Is_Null_Loop (Parent (N));
+
+                              --  Here is where the loop could execute because
+                              --  of invalid values, so issue appropriate
+                              --  message and in this case we do not set the
+                              --  Is_Null_Loop flag since the loop may execute.
+
+                              else
+                                 Error_Msg_N
+                                   ("?loop range may be null, "
+                                    & "loop may not execute",
+                                    DS);
+                                 Error_Msg_N
+                                   ("?can only execute if invalid values "
+                                    & "are present",
+                                    DS);
+                              end if;
                            end if;
 
-                           --  Since we know the range of the loop is null,
-                           --  set the appropriate flag to suppress any
-                           --  warnings that would otherwise be issued in
-                           --  the body of the loop that will not execute.
-                           --  We do this even in the generic case, since
-                           --  if it is dubious to warn on the null loop
-                           --  itself, it is certainly dubious to warn for
-                           --  conditions that occur inside it!
+                           --  In either case, suppress warnings in the body of
+                           --  the loop, since it is likely that these warnings
+                           --  will be inappropriate if the loop never actually
+                           --  executes, which is unlikely.
 
-                           Set_Is_Null_Loop (Parent (N));
+                           Set_Suppress_Loop_Warnings (Parent (N));
 
                         --  The other case for a warning is a reverse loop
                         --  where the upper bound is the integer literal
@@ -1898,10 +1912,9 @@ package body Sem_Ch5 is
                         elsif Reverse_Present (LP)
                           and then Nkind (Original_Node (H)) =
                                                           N_Integer_Literal
-                          and then (Intval (H) = Uint_0
+                          and then (Intval (Original_Node (H)) = Uint_0
                                       or else
-                                    Intval (H) = Uint_1)
-                          and then Lhi > Hhi
+                                    Intval (Original_Node (H)) = Uint_1)
                         then
                            Error_Msg_N ("?loop range may be null", DS);
                            Error_Msg_N ("\?bounds may be wrong way round", DS);
diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
index b9c1d13..2d3e2cb 100644
--- a/gcc/ada/sem_eval.adb
+++ b/gcc/ada/sem_eval.adb
@@ -241,7 +241,7 @@ package body Sem_Eval is
 
       if not Is_Static_Expression (N) then
          if Is_Floating_Point_Type (T)
-           and then Is_Out_Of_Range (N, Base_Type (T))
+           and then Is_Out_Of_Range (N, Base_Type (T), Assume_Valid => True)
          then
             Error_Msg_N
               ("?float value out of range, infinity will be generated", N);
@@ -271,7 +271,7 @@ package body Sem_Eval is
          --  number, so as not to lose case where value overflows in the
          --  least significant bit or less. See B490001.
 
-         if Is_Out_Of_Range (N, Base_Type (T)) then
+         if Is_Out_Of_Range (N, Base_Type (T), Assume_Valid => True) then
             Out_Of_Range (N);
             return;
          end if;
@@ -325,21 +325,21 @@ package body Sem_Eval is
 
       --  Check out of range of base type
 
-      elsif Is_Out_Of_Range (N, Base_Type (T)) then
+      elsif Is_Out_Of_Range (N, Base_Type (T), Assume_Valid => True) then
          Out_Of_Range (N);
 
-      --  Give warning if outside subtype (where one or both of the
-      --  bounds of the subtype is static). This warning is omitted
-      --  if the expression appears in a range that could be null
-      --  (warnings are handled elsewhere for this case).
+      --  Give warning if outside subtype (where one or both of the bounds of
+      --  the subtype is static). This warning is omitted if the expression
+      --  appears in a range that could be null (warnings are handled elsewhere
+      --  for this case).
 
       elsif T /= Base_Type (T)
         and then Nkind (Parent (N)) /= N_Range
       then
-         if Is_In_Range (N, T) then
+         if Is_In_Range (N, T, Assume_Valid => True) then
             null;
 
-         elsif Is_Out_Of_Range (N, T) then
+         elsif Is_Out_Of_Range (N, T, Assume_Valid => True) then
             Apply_Compile_Time_Constraint_Error
               (N, "value not in range of}?", CE_Range_Check_Failed);
 
@@ -574,16 +574,17 @@ package body Sem_Eval is
 
       begin
          --  Values are the same if they refer to the same entity and the
-         --  entity is a constant object (E_Constant). This does not however
-         --  apply to Float types, since we may have two NaN values and they
-         --  should never compare equal.
+         --  entity is non-volatile. This does not however apply to Float
+         --  types, since we may have two NaN values and they should never
+         --  compare equal.
 
          if Nkind_In (Lf, N_Identifier, N_Expanded_Name)
            and then Nkind_In (Rf, N_Identifier, N_Expanded_Name)
            and then Entity (Lf) = Entity (Rf)
            and then Present (Entity (Lf))
            and then not Is_Floating_Point_Type (Etype (L))
-           and then Is_Constant_Object (Entity (Lf))
+           and then not Is_Volatile_Reference (L)
+           and then not Is_Volatile_Reference (R)
          then
             return True;
 
@@ -748,7 +749,7 @@ package body Sem_Eval is
          --  not known to have valid representations. This takes care of
          --  properly dealing with invalid representations.
 
-         if not Assume_Valid then
+         if not Assume_Valid and then not Assume_No_Invalid_Values then
             if Is_Entity_Name (L) and then not Is_Known_Valid (Entity (L)) then
                Ltyp := Base_Type (Ltyp);
             end if;
@@ -758,6 +759,39 @@ package body Sem_Eval is
             end if;
          end if;
 
+         --  Try range analysis on variables and see if ranges are disjoint
+
+         declare
+            LOK, ROK : Boolean;
+            LLo, LHi : Uint;
+            RLo, RHi : Uint;
+
+         begin
+            Determine_Range (L, LOK, LLo, LHi, Assume_Valid);
+            Determine_Range (R, ROK, RLo, RHi, Assume_Valid);
+
+            if LOK and ROK then
+               if LHi < RLo then
+                  return LT;
+
+               elsif RHi < LLo then
+                  return GT;
+
+               elsif LLo = LHi
+                 and then RLo = RHi
+                 and then LLo = RLo
+               then
+                  return EQ;
+
+               elsif LHi = RLo then
+                  return LE;
+
+               elsif RHi = LLo then
+                  return GE;
+               end if;
+            end if;
+         end;
+
          --  Here is where we check for comparisons against maximum bounds of
          --  types, where we know that no value can be outside the bounds of
          --  the subtype. Note that this routine is allowed to assume that all
@@ -1812,7 +1846,7 @@ package body Sem_Eval is
       --  Modular integer literals must be in their base range
 
       if Is_Modular_Integer_Type (T)
-        and then Is_Out_Of_Range (N, Base_Type (T))
+        and then Is_Out_Of_Range (N, Base_Type (T), Assume_Valid => True)
       then
          Out_Of_Range (N);
       end if;
@@ -2276,7 +2310,7 @@ package body Sem_Eval is
 
       Set_Is_Static_Expression (N, Stat);
 
-      if Is_Out_Of_Range (N, Etype (N)) then
+      if Is_Out_Of_Range (N, Etype (N), Assume_Valid => True) then
          Out_Of_Range (N);
       end if;
    end Eval_Qualified_Expression;
@@ -2998,7 +3032,7 @@ package body Sem_Eval is
          Fold_Uint (N, Expr_Value (Operand), Stat);
       end if;
 
-      if Is_Out_Of_Range (N, Etype (N)) then
+      if Is_Out_Of_Range (N, Etype (N), Assume_Valid => True) then
          Out_Of_Range (N);
       end if;
 
@@ -3610,10 +3644,11 @@ package body Sem_Eval is
    -----------------
 
    function Is_In_Range
-     (N         : Node_Id;
-      Typ       : Entity_Id;
-      Fixed_Int : Boolean := False;
-      Int_Real  : Boolean := False) return Boolean
+     (N            : Node_Id;
+      Typ          : Entity_Id;
+      Assume_Valid : Boolean := False;
+      Fixed_Int    : Boolean := False;
+      Int_Real     : Boolean := False) return Boolean
    is
       Val  : Uint;
       Valr : Ureal;
@@ -3635,19 +3670,38 @@ package body Sem_Eval is
       elsif not Compile_Time_Known_Value (N) then
          return False;
 
+      --  General processing with a known compile time value
+
       else
          declare
-            Lo       : constant Node_Id := Type_Low_Bound  (Typ);
-            Hi       : constant Node_Id := Type_High_Bound (Typ);
-            LB_Known : constant Boolean := Compile_Time_Known_Value (Lo);
-            UB_Known : constant Boolean := Compile_Time_Known_Value (Hi);
+            Lo       : Node_Id;
+            Hi       : Node_Id;
+            LB_Known : Boolean;
+            UB_Known : Boolean;
+            Typt     : Entity_Id;
 
          begin
+            if Assume_Valid
+              or else Assume_No_Invalid_Values
+              or else (Is_Entity_Name (N)
+                        and then Is_Known_Valid (Entity (N)))
+            then
+               Typt := Typ;
+            else
+               Typt := Underlying_Type (Base_Type (Typ));
+            end if;
+
+            Lo := Type_Low_Bound  (Typt);
+            Hi := Type_High_Bound (Typt);
+
+            LB_Known := Compile_Time_Known_Value (Lo);
+            UB_Known := Compile_Time_Known_Value (Hi);
+
             --  Fixed point types should be considered as such only in
             --  flag Fixed_Int is set to False.
 
-            if Is_Floating_Point_Type (Typ)
-              or else (Is_Fixed_Point_Type (Typ) and then not Fixed_Int)
+            if Is_Floating_Point_Type (Typt)
+              or else (Is_Fixed_Point_Type (Typt) and then not Fixed_Int)
               or else Int_Real
             then
                Valr := Expr_Value_R (N);
@@ -3792,6 +3846,7 @@ package body Sem_Eval is
    function Is_Out_Of_Range
      (N            : Node_Id;
       Typ          : Entity_Id;
+      Assume_Valid : Boolean := False;
       Fixed_Int    : Boolean := False;
       Int_Real     : Boolean := False) return Boolean
    is
@@ -3826,18 +3881,37 @@ package body Sem_Eval is
 
       else
          declare
-            Lo       : constant Node_Id := Type_Low_Bound  (Typ);
-            Hi       : constant Node_Id := Type_High_Bound (Typ);
-            LB_Known : constant Boolean := Compile_Time_Known_Value (Lo);
-            UB_Known : constant Boolean := Compile_Time_Known_Value (Hi);
+            Lo       : Node_Id;
+            Hi       : Node_Id;
+            LB_Known : Boolean;
+            UB_Known : Boolean;
+            Typt     : Entity_Id;
 
          begin
+            --  Go to base type if we could have invalid values
+
+            if Assume_Valid
+              or else Assume_No_Invalid_Values
+              or else (Is_Entity_Name (N)
+                        and then Is_Known_Valid (Entity (N)))
+            then
+               Typt := Typ;
+            else
+               Typt := Underlying_Type (Base_Type (Typ));
+            end if;
+
+            Lo := Type_Low_Bound (Typt);
+            Hi := Type_High_Bound (Typt);
+
+            LB_Known := Compile_Time_Known_Value (Lo);
+            UB_Known := Compile_Time_Known_Value (Hi);
+
             --  Real types (note that fixed-point types are not treated
             --  as being of a real type if the flag Fixed_Int is set,
             --  since in that case they are regarded as integer types).
 
-            if Is_Floating_Point_Type (Typ)
-              or else (Is_Fixed_Point_Type (Typ) and then not Fixed_Int)
+            if Is_Floating_Point_Type (Typt)
+              or else (Is_Fixed_Point_Type (Typt) and then not Fixed_Int)
               or else Int_Real
             then
                Valr := Expr_Value_R (N);
diff --git a/gcc/ada/sem_eval.ads b/gcc/ada/sem_eval.ads
index f294ed4..97b0967 100644
--- a/gcc/ada/sem_eval.ads
+++ b/gcc/ada/sem_eval.ads
@@ -327,10 +327,11 @@ package Sem_Eval is
    --  known at compile time but not static, then the result is not static.
 
    function Is_In_Range
-     (N         : Node_Id;
-      Typ       : Entity_Id;
-      Fixed_Int : Boolean := False;
-      Int_Real  : Boolean := False) return Boolean;
+     (N            : Node_Id;
+      Typ          : Entity_Id;
+      Assume_Valid : Boolean := False;
+      Fixed_Int    : Boolean := False;
+      Int_Real     : Boolean := False) return Boolean;
    --  Returns True if it can be guaranteed at compile time that expression is
    --  known to be in range of the subtype Typ. If the values of N or of either
    --  bounds of Type are unknown at compile time, False will always be
@@ -345,13 +346,16 @@ package Sem_Eval is
    --  value (i.e. the underlying integer value is used). In this case we use
    --  the corresponding integer value, both for the bounds of Typ, and for the
    --  value of the expression N. If Typ is a discrete type and Fixed_Int as
-   --  well as Int_Real are false, integer values are used throughout.
+   --  well as Int_Real are false, integer values are used throughout. The
+   --  Assume_Valid parameter determines whether values are to be assumed to
+   --  be valid (True), or invalid values can occur (False).
 
    function Is_Out_Of_Range
-     (N         : Node_Id;
-      Typ       : Entity_Id;
-      Fixed_Int : Boolean := False;
-      Int_Real  : Boolean := False) return Boolean;
+     (N            : Node_Id;
+      Typ          : Entity_Id;
+      Assume_Valid : Boolean := False;
+      Fixed_Int    : Boolean := False;
+      Int_Real     : Boolean := False) return Boolean;
    --  Returns True if it can be guaranteed at compile time that expression is
    --  known to be out of range of the subtype Typ. True is returned if Typ is
    --  a scalar type, at least one of whose bounds is known at compile time,
@@ -359,7 +363,9 @@ package Sem_Eval is
    --  outside a compile_time known bound of Typ. A result of False does not
    --  mean that the expression is in range, but rather merely that it cannot
    --  be determined at compile time that it is out of range. Flags Int_Real
-   --  and Fixed_Int are used as in routine Is_In_Range above.
+   --  and Fixed_Int are used as in routine Is_In_Range above. The Assume_Valid
+   --  parameter determines whether values are to be assumed to be valid
+   --  (True), or invalid values can occur (False).
 
    function In_Subrange_Of
      (T1           : Entity_Id;
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 82dca56..4adaa56 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -2963,7 +2963,8 @@ package body Sem_Util is
                elsif Is_Entity_Name (Choice)
                  and then Is_Type (Entity (Choice))
                then
-                  exit Search when Is_In_Range (Expr, Etype (Choice));
+                  exit Search when Is_In_Range (Expr, Etype (Choice),
+                                                Assume_Valid => False);
 
                --  Choice is a subtype indication
 
diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb
index 534023f..6fd7da9 100644
--- a/gcc/ada/sinfo.adb
+++ b/gcc/ada/sinfo.adb
@@ -2623,6 +2623,14 @@ package body Sinfo is
       return Node5 (N);
    end Subtype_Indication;
 
+   function Suppress_Loop_Warnings
+      (N : Node_Id) return Boolean is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Loop_Statement);
+      return Flag17 (N);
+   end Suppress_Loop_Warnings;
+
    function Subtype_Mark
       (N : Node_Id) return Node_Id is
    begin
@@ -5411,6 +5419,14 @@ package body Sinfo is
       Set_List2_With_Parent (N, Val);
    end Set_Subtype_Marks;
 
+   procedure Set_Suppress_Loop_Warnings
+      (N : Node_Id; Val : Boolean := True) is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Loop_Statement);
+      Set_Flag17 (N, Val);
+   end Set_Suppress_Loop_Warnings;
+
    procedure Set_Synchronized_Present
      (N : Node_Id; Val : Boolean := True) is
    begin
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index ddf5c1f..bf428e8 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -1200,9 +1200,8 @@ package Sinfo is
 
    --  Is_Null_Loop (Flag16-Sem)
    --    This flag is set in an N_Loop_Statement node if the corresponding loop
-   --    can be determined to be null at compile time. This is used to suppress
-   --    any warnings that would otherwise be issued inside the loop since they
-   --    are probably not useful.
+   --    can be determined to be null at compile time. This is used to remove
+   --    the loop entirely at expansion time.
 
    --  Is_Overloaded (Flag5-Sem)
    --    A flag present in all expression nodes. Used temporarily during
@@ -1597,6 +1596,12 @@ package Sinfo is
    --    value of a type whose size is not known at compile time on the
    --    secondary stack.
 
+   --  Suppress_Loop_Warnings (Flag17-Sem)
+   --    Used in N_Loop_Statement node to indicate that warnings within the
+   --    body of the loop should be suppressed. This is set when the range
+   --    of a FOR loop is known to be null, or is probably null (loop would
+   --    only execute if invalid values are present).
+
    --  Target_Type (Node2-Sem)
    --    Used in an N_Validate_Unchecked_Conversion node to point to the target
    --    type entity for the unchecked conversion instantiation which gigi must
@@ -3940,6 +3945,7 @@ package Sinfo is
       --  End_Label (Node4)
       --  Has_Created_Identifier (Flag15)
       --  Is_Null_Loop (Flag16)
+      --  Suppress_Loop_Warnings (Flag17)
 
       --------------------------
       -- 5.5 Iteration Scheme --
@@ -8252,6 +8258,9 @@ package Sinfo is
    function Subtype_Marks
      (N : Node_Id) return List_Id;    -- List2
 
+   function Suppress_Loop_Warnings
+     (N : Node_Id) return Boolean;    -- Flag17
+
    function Synchronized_Present
      (N : Node_Id) return Boolean;    -- Flag7
 
@@ -9131,6 +9140,9 @@ package Sinfo is
    procedure Set_Subtype_Marks
      (N : Node_Id; Val : List_Id);            -- List2
 
+   procedure Set_Suppress_Loop_Warnings
+     (N : Node_Id; Val : Boolean := True);    -- Flag17
+
    procedure Set_Synchronized_Present
      (N : Node_Id; Val : Boolean := True);    -- Flag7
 
@@ -11108,6 +11120,7 @@ package Sinfo is
    pragma Inline (Subtype_Indication);
    pragma Inline (Subtype_Mark);
    pragma Inline (Subtype_Marks);
+   pragma Inline (Suppress_Loop_Warnings);
    pragma Inline (Synchronized_Present);
    pragma Inline (Tagged_Present);
    pragma Inline (Target_Type);
@@ -11397,6 +11410,7 @@ package Sinfo is
    pragma Inline (Set_Subtype_Indication);
    pragma Inline (Set_Subtype_Mark);
    pragma Inline (Set_Subtype_Marks);
+   pragma Inline (Set_Suppress_Loop_Warnings);
    pragma Inline (Set_Synchronized_Present);
    pragma Inline (Set_Tagged_Present);
    pragma Inline (Set_Target_Type);