From 7649892bfc838aeb0723200b56f34bebe2a87b46 Mon Sep 17 00:00:00 2001
From: Arnaud Charlet <charlet@adacore.com>
Date: Tue, 15 Sep 2020 08:56:31 -0400
Subject: [PATCH] [Ada] Suppress warnings on unreferenced parameters of
 dispatching ops

gcc/ada/

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

gcc/testsuite/

	* gnat.dg/warn14.adb: Update expectations.
---
 gcc/ada/sem_warn.adb             | 29 ++++++++++++++++++-----------
 gcc/testsuite/gnat.dg/warn14.adb |  2 +-
 2 files changed, 19 insertions(+), 12 deletions(-)

diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
index d1acf2f..7289ea7 100644
--- a/gcc/ada/sem_warn.adb
+++ b/gcc/ada/sem_warn.adb
@@ -4421,23 +4421,30 @@ package body Sem_Warn is
                      end if;
 
                      declare
-                        B : constant Node_Id := Parent (Parent (Scope (E)));
-                        S : Entity_Id := Empty;
+                        S : Node_Id := Scope (E);
                      begin
-                        if Nkind (B) in
-                             N_Expression_Function |
-                             N_Subprogram_Body     |
-                             N_Subprogram_Renaming_Declaration
-                        then
-                           S := Corresponding_Spec (B);
+                        if Ekind (S) = E_Subprogram_Body then
+                           S := Parent (S);
+
+                           while Nkind (S) not in
+                             N_Expression_Function             |
+                             N_Subprogram_Body                 |
+                             N_Subprogram_Renaming_Declaration |
+                             N_Empty
+                           loop
+                              S := Parent (S);
+                           end loop;
+
+                           if Present (S) then
+                              S := Corresponding_Spec (S);
+                           end if;
                         end if;
 
                         --  Do not warn for dispatching operations, because
                         --  that causes too much noise. Also do not warn for
-                        --  trivial subprograms.
+                        --  trivial subprograms (e.g. stubs).
 
-                        if (not Present (S)
-                            or else not Is_Dispatching_Operation (S))
+                        if (No (S) or else not Is_Dispatching_Operation (S))
                           and then not Is_Trivial_Subprogram (Scope (E))
                         then
                            Error_Msg_NE -- CODEFIX
diff --git a/gcc/testsuite/gnat.dg/warn14.adb b/gcc/testsuite/gnat.dg/warn14.adb
index d7fbece..f9d03d1 100644
--- a/gcc/testsuite/gnat.dg/warn14.adb
+++ b/gcc/testsuite/gnat.dg/warn14.adb
@@ -23,7 +23,7 @@ procedure Warn14 is
   package YY is
     type XX is tagged null record;
 
-    function F4 (Y : XX; U : Boolean) return Natural is (1); --  { dg-warning "formal parameter \"U\" is not referenced" }
+    function F4 (Y : XX; U : Boolean) return Natural is (1);
   end YY;
 
   XXX : YY.XX;
-- 
2.7.4