diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 8 | ||||
| -rw-r--r-- | gcc/ada/sem_warn.adb | 47 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 4 | ||||
| -rw-r--r-- | gcc/testsuite/gnat.dg/warn28.adb | 36 | ||||
| -rw-r--r-- | gcc/testsuite/gnat.dg/warn28.ads | 9 |
5 files changed, 103 insertions, 1 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c01d358..64f3cbb 100644 --- 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 ab85162..ca6515c 100644 --- 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 e3b30d2..f3cff77 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,5 +1,9 @@ 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. 2019-08-19 Olivier Hainque <hainque@adacore.com> diff --git a/gcc/testsuite/gnat.dg/warn28.adb b/gcc/testsuite/gnat.dg/warn28.adb new file mode 100644 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 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; |