[multiple changes]

2017-04-25  Hristian Kirtchev  <kirtchev@adacore.com>

	* comperr.adb (Compiler_Abort): Add a pair of pragma Warnings
	On/Off to defend against a spurious warning in conditional
	compilation.
	* exp_ch4.adb (Rewrite_Comparison): Reimplemented.
	* namet.adb (Finalize): Add a pair of pragma Warnings On/Off to
	defend against a spurious warning in conditional compilation.
	* output.adb Add a pair of pragma Warnings On/Off to defend
	against a spurious warning in conditional compilation.
	* sem_eval.adb (Eval_Relational_Op): Major code clean up.
	(Fold_General_Op): New routine.
	(Fold_Static_Real_Op): New routine.
	(Test_Comparison): New routine.
	* sem_eval.ads (Test_Comparison): New routine.
	* sem_warn.adb (Is_Attribute_Constant_Comparison): New routine.
	(Warn_On_Constant_Valid_Condition): New routine.
	(Warn_On_Known_Condition): Use Is_Attribute_Constant_Comparison
	to detect a specific case.
	* sem_warn.adb (Warn_On_Constant_Valid_Condition): New routine.
	* urealp.adb (Tree_Read): Add a pair of pragma Warnings On/Off
	to defend against a spurious warning in conditional compilation.
	(Tree_Write): Add a pair of pragma Warnings On/Off to defend
	against a spurious warning in conditional compilation.
	* usage.adb Add a pair of pragma Warnings On/Off to defend
	against a spurious warning in conditional compilation.

2017-04-25  Arnaud Charlet  <charlet@adacore.com>

	* sinfo.ads, sem_ch13.adb: Update comment.

From-SVN: r247224

gcc/ada/ChangeLog

 2017-04-25  Hristian Kirtchev  <kirtchev@adacore.com>
 
+	* comperr.adb (Compiler_Abort): Add a pair of pragma Warnings
+	On/Off to defend against a spurious warning in conditional
+	compilation.
+	* exp_ch4.adb (Rewrite_Comparison): Reimplemented.
+	* namet.adb (Finalize): Add a pair of pragma Warnings On/Off to
+	defend against a spurious warning in conditional compilation.
+	* output.adb Add a pair of pragma Warnings On/Off to defend
+	against a spurious warning in conditional compilation.
+	* sem_eval.adb (Eval_Relational_Op): Major code clean up.
+	(Fold_General_Op): New routine.
+	(Fold_Static_Real_Op): New routine.
+	(Test_Comparison): New routine.
+	* sem_eval.ads (Test_Comparison): New routine.
+	* sem_warn.adb (Is_Attribute_Constant_Comparison): New routine.
+	(Warn_On_Constant_Valid_Condition): New routine.
+	(Warn_On_Known_Condition): Use Is_Attribute_Constant_Comparison
+	to detect a specific case.
+	* sem_warn.adb (Warn_On_Constant_Valid_Condition): New routine.
+	* urealp.adb (Tree_Read): Add a pair of pragma Warnings On/Off
+	to defend against a spurious warning in conditional compilation.
+	(Tree_Write): Add a pair of pragma Warnings On/Off to defend
+	against a spurious warning in conditional compilation.
+	* usage.adb Add a pair of pragma Warnings On/Off to defend
+	against a spurious warning in conditional compilation.
+
+2017-04-25  Arnaud Charlet  <charlet@adacore.com>
+
+	* sinfo.ads, sem_ch13.adb: Update comment.
+
+2017-04-25  Hristian Kirtchev  <kirtchev@adacore.com>
+
 	* sem_util.adb (Is_Post_State): A reference to a
 	generic in out parameter is considered a change in the post-state
 	of a subprogram.

gcc/ada/comperr.adb

@@ -98,9 +98,18 @@ package body Comperr is
          Write_Eol;
       end End_Line;
 
+      --  Disable the warnings emitted by -gnatwc because the following two
+      --  constants are initialized by means of conditional compilation.
+
+      pragma Warnings
+        (Off, "condition can only be * if invalid values present");
+
       Is_GPL_Version : constant Boolean := Gnatvsn.Build_Type = GPL;
       Is_FSF_Version : constant Boolean := Gnatvsn.Build_Type = FSF;
 
+      pragma Warnings
+        (On, "condition can only be * if invalid values present");
+
    --  Start of processing for Compiler_Abort
 
    begin

gcc/ada/exp_ch4.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2016, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2017, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -13211,12 +13211,10 @@ 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.
+      Typ : constant Entity_Id := Etype (N);
 
-      Result : Node_Id;
-      --  Set to Standard_True or Standard_False
+      False_Result : Boolean;
+      True_Result  : Boolean;
 
    begin
       if Nkind (N) = N_Type_Conversion then
@@ -13227,125 +13225,31 @@ package body Exp_Ch4 is
          return;
       end if;
 
-      --  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 skip 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 => AV);
-            --  Res indicates if compare outcome can be compile time determined
-
-            True_Result  : Boolean;
-            False_Result : Boolean;
-
-         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;
-
-               when N_Op_Ge =>
-                  True_Result  := Res in Compare_GE;
-                  False_Result := Res = LT;
-
-                  if Res = LE
-                    and then Constant_Condition_Warnings
-                    and then Comes_From_Source (Original_Node (N))
-                    and then Nkind (Original_Node (N)) = N_Op_Ge
-                    and then not In_Instance
-                    and then Is_Integer_Type (Etype (Left_Opnd (N)))
-                    and then not Has_Warnings_Off (Etype (Left_Opnd (N)))
-                  then
-                     Error_Msg_N
-                       ("can never be greater than, could replace by "
-                        & """'=""?c?", N);
-                     Warning_Generated := True;
-                  end if;
-
-               when N_Op_Gt =>
-                  True_Result  := Res = GT;
-                  False_Result := Res in Compare_LE;
-
-               when N_Op_Lt =>
-                  True_Result  := Res = LT;
-                  False_Result := Res in Compare_GE;
+      --  Determine the potential outcome of the comparison assuming that the
+      --  operands are valid and emit a warning when the comparison evaluates
+      --  to True or False only in the presence of invalid values.
 
-               when N_Op_Le =>
-                  True_Result  := Res in Compare_LE;
-                  False_Result := Res = GT;
+      Warn_On_Constant_Valid_Condition (N);
 
-                  if Res = GE
-                    and then Constant_Condition_Warnings
-                    and then Comes_From_Source (Original_Node (N))
-                    and then Nkind (Original_Node (N)) = N_Op_Le
-                    and then not In_Instance
-                    and then Is_Integer_Type (Etype (Left_Opnd (N)))
-                    and then not Has_Warnings_Off (Etype (Left_Opnd (N)))
-                  then
-                     Error_Msg_N
-                       ("can never be less than, could replace by ""'=""?c?",
-                        N);
-                     Warning_Generated := True;
-                  end if;
+      --  Determine the potential outcome of the comparison assuming that the
+      --  operands are not valid.
 
-               when N_Op_Ne =>
-                  True_Result  := Res = NE or else Res = GT or else Res = LT;
-                  False_Result := Res = EQ;
-            end case;
+      Test_Comparison
+        (Op           => N,
+         Assume_Valid => False,
+         True_Result  => True_Result,
+         False_Result => False_Result);
 
-            --  If this is the first iteration, then we actually convert the
-            --  comparison into True or False, if the result is certain.
+      --  The outcome is a decisive False or True, rewrite the operator
 
-            if AV = False then
-               if True_Result or False_Result then
-                  Result := Boolean_Literals (True_Result);
+      if False_Result or True_Result then
          Rewrite (N,
            Convert_To (Typ,
-                      New_Occurrence_Of (Result, Sloc (N))));
+             New_Occurrence_Of (Boolean_Literals (True_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;
 
    ----------------------------

gcc/ada/namet.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2016, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2017, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -672,6 +672,12 @@ package body Namet is
                   Max_Chain_Length := C;
                end if;
 
+               --  Disable the warnings emitted by -gnatwc because the tests
+               --  involving Verbosity involve conditional compilation.
+
+               pragma Warnings
+                 (Off, "condition can only be * if invalid values present");
+
                if Verbosity >= 2 then
                   Write_Str ("Hash_Table (");
                   Write_Int (J);
@@ -703,6 +709,9 @@ package body Namet is
                      N := Name_Entries.Table (N).Hash_Link;
                   end loop;
                end if;
+
+               pragma Warnings
+                 (On, "condition can only be * if invalid values present");
             end;
          end if;
       end loop;

gcc/ada/output.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2017, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -55,7 +55,12 @@ package body Output is
    Indentation_Limit : constant Positive := 40;
    --  Indentation beyond this number of spaces wraps around
 
+   --  Disable the warnings emitted by -gnatwc because the comparison within
+   --  the assertion depends on conditional compilation.
+
+   pragma Warnings (Off, "condition can only be * if invalid values present");
    pragma Assert (Indentation_Limit < Buffer_Max / 2);
+   pragma Warnings (On,  "condition can only be * if invalid values present");
    --  Make sure this is substantially shorter than the line length
 
    Cur_Indentation : Natural := 0;

gcc/ada/sem_ch13.adb

@@ -2456,7 +2456,8 @@ package body Sem_Ch13 is
 
                      goto Continue;
 
-                  --  For tasks pass the aspect as an attribute
+                  --  For task and protected types pass the aspect as an
+                  --  attribute.
 
                   else
                      Aitem :=

gcc/ada/sem_eval.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2017, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -508,6 +508,16 @@ package Sem_Eval is
    --  except when testing a generic actual T1 against an ancestor T2 in a
    --  formal derived type association (indicated by Formal_Derived_Matching).
 
+   procedure Test_Comparison
+     (Op           : Node_Id;
+      Assume_Valid : Boolean;
+      True_Result  : out Boolean;
+      False_Result : out Boolean);
+   --  Determine the outcome of evaluating comparison operator Op using routine
+   --  Compile_Time_Compare. Assume_Valid should be set when the operands are
+   --  to be assumed valid. Flags True_Result and False_Result are set when the
+   --  comparison evaluates to True or False respectively.
+
    procedure Why_Not_Static (Expr : Node_Id);
    --  This procedure may be called after generating an error message that
    --  complains that something is non-static. If it finds good reasons, it

gcc/ada/sem_warn.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1999-2016, Free Software Foundation, Inc.         --
+--          Copyright (C) 1999-2017, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -141,6 +141,12 @@ package body Sem_Warn is
    --  a body formal, the setting of the flag in the corresponding spec is
    --  also checked (and True returned if either flag is True).
 
+   function Is_Attribute_And_Known_Value_Comparison
+     (Op : Node_Id) return Boolean;
+   --  Determine whether operator Op denotes a comparison where the left
+   --  operand is an attribute reference and the value of the right operand is
+   --  known at compile time.
+
    function Never_Set_In_Source_Check_Spec (E : Entity_Id) return Boolean;
    --  Tests Never_Set_In_Source status for entity E. If E is not a formal,
    --  this is simply the setting of the flag Never_Set_In_Source. If E is
@@ -2840,6 +2846,23 @@ package body Sem_Warn is
       In_Out_Warnings.Init;
    end Initialize;
 
+   ---------------------------------------------
+   -- Is_Attribute_And_Known_Value_Comparison --
+   ---------------------------------------------
+
+   function Is_Attribute_And_Known_Value_Comparison
+     (Op : Node_Id) return Boolean
+   is
+      Orig_Op : constant Node_Id := Original_Node (Op);
+
+   begin
+      return
+        Nkind (Orig_Op) in N_Op_Compare
+          and then Nkind (Original_Node (Left_Opnd (Orig_Op))) =
+                     N_Attribute_Reference
+          and then Compile_Time_Known_Value (Right_Opnd (Orig_Op));
+   end Is_Attribute_And_Known_Value_Comparison;
+
    ------------------------------------
    -- Never_Set_In_Source_Check_Spec --
    ------------------------------------
@@ -3239,13 +3262,55 @@ package body Sem_Warn is
       end if;
    end Referenced_As_Out_Parameter_Check_Spec;
 
+   --------------------------------------
+   -- Warn_On_Constant_Valid_Condition --
+   --------------------------------------
+
+   procedure Warn_On_Constant_Valid_Condition (Op : Node_Id) is
+      True_Result  : Boolean;
+      False_Result : Boolean;
+
+   begin
+      --  Determine the potential outcome of the comparison assuming that the
+      --  operands are valid. Do not consider instances because the check was
+      --  already performed in the generic. Do not consider comparison between
+      --  an attribute reference and a compile time known value since this is
+      --  most likely a conditional compilation. Do not consider internal files
+      --  in order to allow for various assertions and safeguards within our
+      --  runtime.
+
+      if Constant_Condition_Warnings
+        and then Comes_From_Source (Original_Node (Op))
+        and then not In_Instance
+        and then not Is_Attribute_And_Known_Value_Comparison (Op)
+        and then not Is_Internal_File_Name
+                       (Unit_File_Name (Get_Source_Unit (Op)))
+      then
+         Test_Comparison
+           (Op           => Op,
+            Assume_Valid => True,
+            True_Result  => True_Result,
+            False_Result => False_Result);
+
+         --  Warn on a possible evaluation to False / True in the presence of
+         --  invalid values.
+
+         if True_Result then
+            Error_Msg_N
+              ("condition can only be False if invalid values present??", Op);
+
+         elsif False_Result then
+            Error_Msg_N
+              ("condition can only be True if invalid values present??", Op);
+         end if;
+      end if;
+   end Warn_On_Constant_Valid_Condition;
+
    -----------------------------
    -- Warn_On_Known_Condition --
    -----------------------------
 
    procedure Warn_On_Known_Condition (C : Node_Id) is
-      P           : Node_Id;
-      Orig        : constant Node_Id := Original_Node (C);
       Test_Result : Boolean;
 
       function Is_Known_Branch return Boolean;
@@ -3327,6 +3392,11 @@ package body Sem_Warn is
          end if;
       end Track;
 
+      --  Local variables
+
+      Orig : constant Node_Id := Original_Node (C);
+      P    : Node_Id;
+
    --  Start of processing for Warn_On_Known_Condition
 
    begin
@@ -3365,11 +3435,7 @@ package body Sem_Warn is
          --  Don't warn if comparison of result of attribute against a constant
          --  value, since this is likely legitimate conditional compilation.
 
-         if Nkind (Orig) in N_Op_Compare
-           and then Compile_Time_Known_Value (Right_Opnd (Orig))
-           and then Nkind (Original_Node (Left_Opnd (Orig))) =
-                                                     N_Attribute_Reference
-         then
+         if Is_Attribute_And_Known_Value_Comparison (C) then
             return;
          end if;
 

gcc/ada/sem_warn.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1999-2016, Free Software Foundation, Inc.         --
+--          Copyright (C) 1999-2017, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -168,6 +168,11 @@ package Sem_Warn is
    --  code has a test that explicitly checks P'First, then it is not operating
    --  in blind assumption mode).
 
+   procedure Warn_On_Constant_Valid_Condition (Op : Node_Id);
+   --  Determine the outcome of evaluating conditional or relational operator
+   --  Op assuming that its operands are valid. Emit a warning when the result
+   --  of the evaluation is True or False.
+
    procedure Warn_On_Known_Condition (C : Node_Id);
    --  C is a node for a boolean expression resulting from a relational
    --  or membership operation. If the expression has a compile time known

gcc/ada/sinfo.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2016, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2017, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -9358,6 +9358,7 @@ package Sinfo is
 
    function Generalized_Indexing
      (N : Node_Id) return Node_Id;    -- Node4
+
    function Generic_Associations
      (N : Node_Id) return List_Id;    -- List3
 

gcc/ada/urealp.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2016, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2017, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -493,7 +493,14 @@ package body Urealp is
 
    procedure Tree_Read is
    begin
+      --  Disable the warnings emitted by -gnatwc because the following check
+      --  acts as a signal in case Num_Ureal_Constants is changed.
+
+      pragma Warnings
+        (Off, "condition can only be * if invalid values present");
       pragma Assert (Num_Ureal_Constants = 10);
+      pragma Warnings
+        (On,  "condition can only be * if invalid values present");
 
       Ureals.Tree_Read;
       Tree_Read_Int (Int (UR_0));
@@ -518,7 +525,14 @@ package body Urealp is
 
    procedure Tree_Write is
    begin
+      --  Disable the warnings emitted by -gnatwc because the following check
+      --  acts as a signal in case Num_Ureal_Constants is changed.
+
+      pragma Warnings
+        (Off, "condition can only be * if invalid values present");
       pragma Assert (Num_Ureal_Constants = 10);
+      pragma Warnings
+        (On,  "condition can only be * if invalid values present");
 
       Ureals.Tree_Write;
       Tree_Write_Int (Int (UR_0));

gcc/ada/usage.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                B o d y                                   --
 --                                                                          --
---          Copyright (C) 1992-2016, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2017, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -671,7 +671,13 @@ begin
    Write_Switch_Char ("zr");
    Write_Line ("Distribution stub generation for receiver stubs");
 
+   --  Disable the warnings emitted by -gnatwc because Ada_Version_Default may
+   --  be changed to denote a different default value.
+
+   pragma Warnings (Off, "condition can only be * if invalid values present");
+
    if not Latest_Ada_Only then
+
       --  Line for -gnat83 switch
 
       Write_Switch_Char ("83");
@@ -708,6 +714,8 @@ begin
       Write_Line ("Ada 2012 mode");
    end if;
 
+   pragma Warnings (On, "condition can only be * if invalid values present");
+
    --  Line for -gnat-p switch
 
    Write_Switch_Char ("-p");