[Ada] Improve placement of warning on formals of generic subprograms

This patch modifies the handling of warnings on unused formal parameters
of generic subprograms. Previously such warnings were placed on the
formal appearing in the subprogram declaration, in contrast with
warnings on non-generic subprograms, where the warning is placed on the
corresponding entity in the body of the subprogram. This patch makes the
handling of both cases uniform. It is preferable to place the warning in
the body because this also provides a better suggestion for the
placement of an Unreferenced pragma to suppress the warning when desired.

2019-08-19  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* sem_warn.adb (Check_References, Generic_Body_Formal): When a
	formal parameter of a generic subprogram is not referenced in
	the body, place the corresponding warning on the corresponding
	entity in the specification of the generic body, as is done for
	non-generic subprograms.

gcc/testsuite/

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

From-SVN: r274649

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index c01d358e71ee2b0cf060734eb79aea6581c15011..64f3cbb7c37397dc38c0ab6362df92c13f8713ca 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,11 @@
+2019-08-19  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_warn.adb (Check_References, Generic_Body_Formal): When a
+       formal parameter of a generic subprogram is not referenced in
+       the body, place the corresponding warning on the corresponding
+       entity in the specification of the generic body, as is done for
+       non-generic subprograms.
+
 2019-08-19  Bob Duff  <duff@adacore.com>
 
        * errout.ads (Size_Too_Small_Message): New constant.

diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
index ab85162c786648a1542edee7c6bfbf07f5a948a5..ca6515c3bcda19c4098752b5e3c3aa8d21ef8ffa 100644 (file)
--- a/gcc/ada/sem_warn.adb
+++ b/gcc/ada/sem_warn.adb
@@ -818,6 +818,14 @@ package body Sem_Warn is
       --  For an entry formal entity from an entry declaration, find the
       --  corresponding body formal from the given accept statement.
 
+      function Generic_Body_Formal (E : Entity_Id) return Entity_Id;
+      --  Warnings on unused formals of subprograms are placed on the entity
+      --  in the subprogram body, which seems preferable because it suggests
+      --  a better codefix for GPS. The analysis of generic subprogram bodies
+      --  uses a different circuitry, so the choice for the proper placement
+      --  of the warning in the generic case takes place here, by finding the
+      --  body entity that corresponds to a formal in a spec.
+
       procedure May_Need_Initialized_Actual (Ent : Entity_Id);
       --  If an entity of a generic type has default initialization, then the
       --  corresponding actual type should be fully initialized, or else there
@@ -876,6 +884,35 @@ package body Sem_Warn is
          raise Program_Error;
       end Body_Formal;
 
+      -------------------------
+      -- Generic_Body_Formal --
+      -------------------------
+
+      function Generic_Body_Formal (E : Entity_Id) return Entity_Id is
+         Gen_Decl : constant Node_Id   := Unit_Declaration_Node (Scope (E));
+         Gen_Body : constant Entity_Id := Corresponding_Body (Gen_Decl);
+         Form     : Entity_Id;
+
+      begin
+         if No (Gen_Body) then
+            return E;
+
+         else
+            Form := First_Entity (Gen_Body);
+            while Present (Form) loop
+               if Chars (Form) = Chars (E) then
+                  return Form;
+               end if;
+
+               Next_Entity (Form);
+            end loop;
+         end if;
+
+         --  Should never fall through, should always find a match
+
+         raise Program_Error;
+      end Generic_Body_Formal;
+
       ---------------------------------
       -- May_Need_Initialized_Actual --
       ---------------------------------
@@ -1688,7 +1725,15 @@ package body Sem_Warn is
                   elsif not Warnings_Off_E1
                     and then not Has_Junk_Name (E1)
                   then
-                     Unreferenced_Entities.Append (E1);
+                     if Is_Formal (E1)
+                       and then Nkind (Unit_Declaration_Node (Scope (E1)))
+                         = N_Generic_Subprogram_Declaration
+                     then
+                        Unreferenced_Entities.Append
+                          (Generic_Body_Formal (E1));
+                     else
+                        Unreferenced_Entities.Append (E1);
+                     end if;
                   end if;
                end if;
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index e3b30d27525074647b3e24c5abbfad33c5c947aa..f3cff77d8e8ec17da6d20a5922c671f5ee0cdc41 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2019-08-19  Ed Schonberg  <schonberg@adacore.com>
+
+       * gnat.dg/warn28.adb, gnat.dg/warn28.ads: New testcase.
+
 2019-08-19  Ed Schonberg  <schonberg@adacore.com>
 
        * gnat.dg/rep_clause9.adb: New testcase.

diff --git a/gcc/testsuite/gnat.dg/warn28.adb b/gcc/testsuite/gnat.dg/warn28.adb
new file mode 100644 (file)
index 0000000..c397dda
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/warn28.adb
@@ -0,0 +1,36 @@
+--  { dg-do compile }
+--  { dg-options "-gnatwa" }
+
+package body Warn28 is
+
+   function Id (X : Integer) return Integer is (2 * X);
+
+   procedure TheProcedure1 (TheParameter : in Integer)
+   is
+   X : Integer;
+   begin
+
+      X := Id (TheParameter);
+      if X < 3 then
+         X := X ** 3;
+      end if;
+   end TheProcedure1;
+
+   procedure Junk (It : Integer) is  --  { dg-warning "formal parameter \"It\" is not referenced" }
+      X : Integer := Id (34);
+   begin
+      if X < 3 then
+         X := X ** 3;
+      end if;
+   end;
+
+   procedure TheProcedure (TheParameter : in Integer)  --  { dg-warning "formal parameter \"TheParameter\" is not referenced" }
+   is
+
+   begin
+
+      null;
+
+   end TheProcedure;
+
+end Warn28;

diff --git a/gcc/testsuite/gnat.dg/warn28.ads b/gcc/testsuite/gnat.dg/warn28.ads
new file mode 100644 (file)
index 0000000..c06c33e
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/warn28.ads
@@ -0,0 +1,9 @@
+package Warn28 is
+
+   procedure TheProcedure1 (TheParameter : in Integer);
+   procedure Junk (It : Integer);
+
+   generic
+   procedure TheProcedure (TheParameter : in Integer);
+
+end Warn28;