[COMMITTED] ada: Suppress warning for specific constant valid condition

Message ID 20221206140219.717392-1-poulhies@adacore.com
State Committed
Commit 188965afb10a2bf14527f2aa9f9cb0f8fcc991e9
Headers
Series [COMMITTED] ada: Suppress warning for specific constant valid condition |

Commit Message

Marc Poulhiès Dec. 6, 2022, 2:02 p.m. UTC
  From: Eric Botcazou <ebotcazou@adacore.com>

Like in Exp_Ch4, we do not want to give warnings in Sem_Warn on a membership
test with a mark for a subtype that is predicated.

gcc/ada/

	* sem_warn.adb (Warn_On_Constant_Valid_Condition): Bail out for a
	membership test with a mark for a subtype that is predicated.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/sem_warn.adb | 40 +++++++++++++++++++++++++++++++++++++++-
 1 file changed, 39 insertions(+), 1 deletion(-)
  

Patch

diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
index 1311916f19c..cb2a3819df6 100644
--- a/gcc/ada/sem_warn.adb
+++ b/gcc/ada/sem_warn.adb
@@ -3290,6 +3290,44 @@  package body Sem_Warn is
       Left  : constant Node_Id := Left_Opnd  (Op);
       Right : constant Node_Id := Right_Opnd (Op);
 
+      function Comes_From_Simple_Condition_In_Source
+        (Op : Node_Id) return Boolean;
+      --  Return True if Op comes from a simple condition present in the source
+
+      -------------------------------------------
+      -- Comes_From_Simple_Condition_In_Source --
+      -------------------------------------------
+
+      function Comes_From_Simple_Condition_In_Source
+        (Op : Node_Id) return Boolean
+      is
+         Orig_Op : constant Node_Id := Original_Node (Op);
+
+      begin
+         if not Comes_From_Source (Orig_Op) then
+            return False;
+         end if;
+
+         --  We do not want to give warnings on a membership test with a mark
+         --  for a subtype that is predicated, see also Exp_Ch4.Expand_N_In.
+
+         if Nkind (Orig_Op) = N_In then
+            declare
+               Orig_Rop : constant Node_Id :=
+                            Original_Node (Right_Opnd (Orig_Op));
+            begin
+               if Is_Entity_Name (Orig_Rop)
+                 and then Is_Type (Entity (Orig_Rop))
+                 and then Present (Predicate_Function (Entity (Orig_Rop)))
+               then
+                  return False;
+               end if;
+            end;
+         end if;
+
+         return True;
+      end Comes_From_Simple_Condition_In_Source;
+
       True_Result  : Boolean;
       False_Result : Boolean;
 
@@ -3298,7 +3336,7 @@  package body Sem_Warn is
       --  scalar operands are valid.
 
       if Constant_Condition_Warnings
-        and then Comes_From_Source (Original_Node (Op))
+        and then Comes_From_Simple_Condition_In_Source (Op)
         and then Is_Scalar_Type (Etype (Left))
         and then Is_Scalar_Type (Etype (Right))