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

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.

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.

From-SVN: r273378

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 1ebe1195b3896c73e9bf87058a59db7bc779de4b..a2316eaf33eeff4fa39cd5bb3b7fc92c76744401 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,8 @@
+2019-07-11  Yannick Moy  <moy@adacore.com>
+
+       * sem_res.adb (Check_Argument_Order): Special case calls to
+       operators.
+
 2019-07-10  Dmitriy Anisimkov  <anisimko@adacore.com>
 
        * libgnat/s-ststop.adb: Remove System.Strings.Stream_Ops

diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index db642f09f88654f9dddd8d6830c9c865c393afe6..78cbac09e36881e5263146300462057423f23ba7 100644 (file)
--- a/gcc/ada/sem_res.adb
+++ b/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;

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index efebc7260a51ced26a6b2730f79aced49a433316..24ecc217f73411f2d09fb28bed60d7f59ef9af83 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2019-07-11  Yannick Moy  <moy@adacore.com>
+
+       * gnat.dg/warn21.adb, gnat.dg/warn21.ads: New testcase.
+
 2019-07-11  Richard Biener  <rguenther@suse.de>
 
        PR middle-end/91131

diff --git a/gcc/testsuite/gnat.dg/warn21.adb b/gcc/testsuite/gnat.dg/warn21.adb
new file mode 100644 (file)
index 0000000..123dfdc
--- /dev/null
+++ b/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;

diff --git a/gcc/testsuite/gnat.dg/warn21.ads b/gcc/testsuite/gnat.dg/warn21.ads
new file mode 100644 (file)
index 0000000..a091467
--- /dev/null
+++ b/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;