From: Yannick Moy <moy@adacore.com>
Date: Thu, 11 Jul 2019 08:01:07 +0000 (+0000)
Subject: [Ada] Avoid spurious warning on wrong order of operator call arguments
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=a34badbdf000e931dfa1a1291cf2739e2c75e68d;p=gcc.git

[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 1ebe1195b38..a2316eaf33e 100644
--- 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 db642f09f88..78cbac09e36 100644
--- 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 efebc7260a5..24ecc217f73 100644
--- 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
index 00000000000..123dfdc67e3
--- /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
index 00000000000..a0914671cf8
--- /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;