[Ada] Avoid spurious warning on wrong order of operator call arguments

[Ada] Avoid spurious warning on wrong order of operator call arguments

[Pierre-Marie de Rodat]

[-- Attachment #1: Type: text/plain, Size: 548 bytes --]

GNAT issues a warning under -gnatwa when actuals for a call are named
like the formals, but in a different order. This is inappropriate for
calls to operators in infix form, when e.g. Right <= Left is in general
the intended order. Special case calls to operators to avoid that
spurious warning.

Tested on x86_64-pc-linux-gnu, committed on trunk

2019-07-11  Yannick Moy  <moy@adacore.com>

gcc/ada/

	* sem_res.adb (Check_Argument_Order): Special case calls to
	operators.

gcc/testsuite/

	* gnat.dg/warn21.adb, gnat.dg/warn21.ads: New testcase.

[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 1797 bytes --]

--- gcc/ada/sem_res.adb
+++ gcc/ada/sem_res.adb
@@ -3458,12 +3458,17 @@ package body Sem_Res is
       begin
          --  Nothing to do if no parameters, or original node is neither a
          --  function call nor a procedure call statement (happens in the
-         --  operator-transformed-to-function call case), or the call does
+         --  operator-transformed-to-function call case), or the call is to an
+         --  operator symbol (which is usually in infix form), or the call does
          --  not come from source, or this warning is off.
 
          if not Warn_On_Parameter_Order
            or else No (Parameter_Associations (N))
            or else Nkind (Original_Node (N)) not in N_Subprogram_Call
+           or else (Nkind (Name (N)) = N_Identifier
+                     and then Present (Entity (Name (N)))
+                     and then Nkind (Entity (Name (N)))
+                       = N_Defining_Operator_Symbol)
            or else not Comes_From_Source (N)
          then
             return;

--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/warn21.adb
@@ -0,0 +1,6 @@
+--  { dg-do compile }
+--  { dg-options "-gnata -gnatwa" }
+
+package body Warn21 is
+   procedure Foo is null;
+end Warn21;

--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/warn21.ads
@@ -0,0 +1,18 @@
+package Warn21 is
+
+   type Set is new Integer;
+
+   function "<=" (Left : Set; Right : Set) return Boolean;
+
+   function "=" (Left : Set; Right : Set) return Boolean with
+     Post   => "="'Result = (Left <= Right and Right <= Left);
+
+   procedure Foo;
+
+private
+
+   function "<=" (Left : Set; Right : Set) return Boolean is (True);
+   function "=" (Left : Set; Right : Set) return Boolean is
+      (Left <= Right and Right <= Left);
+
+end Warn21;