From a34badbdf000e931dfa1a1291cf2739e2c75e68d Mon Sep 17 00:00:00 2001 From: Yannick Moy Date: Thu, 11 Jul 2019 08:01:07 +0000 Subject: [PATCH] [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 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 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/sem_res.adb | 7 ++++++- gcc/testsuite/ChangeLog | 4 ++++ gcc/testsuite/gnat.dg/warn21.adb | 6 ++++++ gcc/testsuite/gnat.dg/warn21.ads | 18 ++++++++++++++++++ 5 files changed, 39 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gnat.dg/warn21.adb create mode 100644 gcc/testsuite/gnat.dg/warn21.ads 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 + + * sem_res.adb (Check_Argument_Order): Special case calls to + operators. + 2019-07-10 Dmitriy Anisimkov * 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 + + * gnat.dg/warn21.adb, gnat.dg/warn21.ads: New testcase. + 2019-07-11 Richard Biener 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; -- 2.30.2