[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.

diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
index d1acf2f23127829dda6f27422fbf511298ba0b56..7289ea78e4594bc63eeb615b349a1280bd035d1a 100644 (file)
--- 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 d7fbecebce3b0f66e06655026adeeea6409d331e..f9d03d1fb04b56afec847b51bf178ae535e9d35d 100644 (file)
--- 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;