[Ada] Suppress warnings on unreferenced parameters of dispatching ops

If the -gnatwf switch is used to activate warnings on unreferenced
formal parameters, the warning is no longer given if the subprogram is
dispatching, because such warnings tend to be noise. It is quite common
to have a parameter that is necessary just because the subprogram is
overriding, or just because we need a controlling parameter for the
dispatch.

2019-08-19  Bob Duff  <duff@adacore.com>

gcc/ada/

	* sem_warn.adb (Warn_On_Unreferenced_Entity): Suppress warning
	on formal parameters of dispatching operations.

gcc/testsuite/

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

From-SVN: r274663

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 1f490b3efe13a5d76087f22c04c8c551eecc2fde..84c2239d209d5d758b613cb1bd1689c266c15e71 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,8 @@
+2019-08-19  Bob Duff  <duff@adacore.com>
+
+       * sem_warn.adb (Warn_On_Unreferenced_Entity): Suppress warning
+       on formal parameters of dispatching operations.
+
 2019-08-19  Ed Schonberg  <schonberg@adacore.com>
 
        * sem_res.adb (Resolve_Call): A call to an expression function

diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
index ca6515c3bcda19c4098752b5e3c3aa8d21ef8ffa..8f85057dc0d700dedc315622178d480c498e7234 100644 (file)
--- a/gcc/ada/sem_warn.adb
+++ b/gcc/ada/sem_warn.adb
@@ -4407,11 +4407,31 @@ package body Sem_Warn is
                         E := Body_E;
                      end if;
 
-                     if not Is_Trivial_Subprogram (Scope (E)) then
-                        Error_Msg_NE -- CODEFIX
-                          ("?u?formal parameter & is not referenced!",
-                           E, Spec_E);
-                     end if;
+                     declare
+                        B : constant Node_Id := Parent (Parent (Scope (E)));
+                        S : Entity_Id := Empty;
+                     begin
+                        if Nkind_In (B,
+                                     N_Expression_Function,
+                                     N_Subprogram_Body,
+                                     N_Subprogram_Renaming_Declaration)
+                        then
+                           S := Corresponding_Spec (B);
+                        end if;
+
+                        --  Do not warn for dispatching operations, because
+                        --  that causes too much noise. Also do not warn for
+                        --  trivial subprograms.
+
+                        if (not Present (S)
+                            or else not Is_Dispatching_Operation (S))
+                          and then not Is_Trivial_Subprogram (Scope (E))
+                        then
+                           Error_Msg_NE -- CODEFIX
+                             ("?u?formal parameter & is not referenced!",
+                              E, Spec_E);
+                        end if;
+                     end;
                   end if;
                end if;
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 2dd707d36c665c85930d62c12449c2c46753201e..5bafa9d636f65738a15e2023de7f8079fc2402ca 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2019-08-19  Bob Duff  <duff@adacore.com>
+
+       * gnat.dg/warn29.adb, gnat.dg/warn29.ads: New testcase.
+
 2019-08-19  Ed Schonberg  <schonberg@adacore.com>
 
        * gnat.dg/expr_func9.adb: New testcase.

diff --git a/gcc/testsuite/gnat.dg/warn29.adb b/gcc/testsuite/gnat.dg/warn29.adb
new file mode 100644 (file)
index 0000000..ec3b9ee
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/warn29.adb
@@ -0,0 +1,11 @@
+--  { dg-do compile }
+--  { dg-options "-gnatwa" }
+
+with Text_IO; use Text_IO;
+
+package body Warn29 is
+   procedure P (X : T; Y : Integer) is
+   begin
+      Put_Line ("hello");
+   end P;
+end Warn29;

diff --git a/gcc/testsuite/gnat.dg/warn29.ads b/gcc/testsuite/gnat.dg/warn29.ads
new file mode 100644 (file)
index 0000000..56c202a
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/warn29.ads
@@ -0,0 +1,4 @@
+package Warn29 is
+   type T is tagged null record;
+   procedure P (X : T; Y : Integer);
+end Warn29;