From 3f89eb7f6dd818224dd0fe0ecb27503fdd0d3283 Mon Sep 17 00:00:00 2001 From: Justin Squirek Date: Tue, 22 May 2018 13:27:14 +0000 Subject: [PATCH] [Ada] Missing warning for unreferenced formals in expression functions This patch fixes an issue whereby the compiler failed to properly warn against unreferenced formal parameters when analyzing expression functions. 2018-05-22 Justin Squirek gcc/ada/ * sem_ch6.adb (Analyze_Expression_Function): Propagate flags from the original function spec into the generated function spec due to expansion of expression functions during analysis. (Analyze_Subprogram_Body_Helper): Modify check on formal parameter references from the body to the subprogram spec in the case of expression functions because of inconsistances related to having a generated body. * libgnarl/s-osinte__android.ads: Flag parameters as unused. * libgnarl/s-osinte__lynxos178e.ads: Likewise. * libgnarl/s-osinte__qnx.adb: Likewise. * libgnarl/s-osinte__qnx.ads: Likewise. gcc/testsuite/ * gnat.dg/warn14.adb: New testcase. From-SVN: r260535 --- gcc/ada/ChangeLog | 14 +++++ gcc/ada/libgnarl/s-osinte__android.ads | 10 ++-- gcc/ada/libgnarl/s-osinte__lynxos178e.ads | 4 +- gcc/ada/libgnarl/s-osinte__qnx.adb | 16 +++++- gcc/ada/libgnarl/s-osinte__qnx.ads | 4 +- gcc/ada/sem_ch6.adb | 65 +++++++++++++++++++---- gcc/testsuite/ChangeLog | 4 ++ gcc/testsuite/gnat.dg/warn14.adb | 33 ++++++++++++ 8 files changed, 130 insertions(+), 20 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/warn14.adb diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 1f7cba903c7..11a74a74a16 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,17 @@ +2018-05-22 Justin Squirek + + * sem_ch6.adb (Analyze_Expression_Function): Propagate flags from the + original function spec into the generated function spec due to + expansion of expression functions during analysis. + (Analyze_Subprogram_Body_Helper): Modify check on formal parameter + references from the body to the subprogram spec in the case of + expression functions because of inconsistances related to having a + generated body. + * libgnarl/s-osinte__android.ads: Flag parameters as unused. + * libgnarl/s-osinte__lynxos178e.ads: Likewise. + * libgnarl/s-osinte__qnx.adb: Likewise. + * libgnarl/s-osinte__qnx.ads: Likewise. + 2018-05-22 Doug Rupp * init.c (HAVE_ADJUST_CONTEXT_FOR_RAISE): Don't define on VxWorks7 for diff --git a/gcc/ada/libgnarl/s-osinte__android.ads b/gcc/ada/libgnarl/s-osinte__android.ads index 67f487e7278..98257172fe6 100644 --- a/gcc/ada/libgnarl/s-osinte__android.ads +++ b/gcc/ada/libgnarl/s-osinte__android.ads @@ -313,7 +313,7 @@ package System.OS_Interface is Stack_Base_Available : constant Boolean := False; -- Indicates whether the stack base is available on this target - function Get_Stack_Base (thread : pthread_t) + function Get_Stack_Base (ignored_thread : pthread_t) return Address is (Null_Address); -- This is a dummy procedure to share some GNULLI files @@ -425,12 +425,12 @@ package System.OS_Interface is PTHREAD_PRIO_INHERIT : constant := 1; function pthread_mutexattr_setprotocol - (attr : access pthread_mutexattr_t; - protocol : int) return int is (0); + (ignored_attr : access pthread_mutexattr_t; + ignored_protocol : int) return int is (0); function pthread_mutexattr_setprioceiling - (attr : access pthread_mutexattr_t; - prioceiling : int) return int is (0); + (ignored_attr : access pthread_mutexattr_t; + ignored_prioceiling : int) return int is (0); type struct_sched_param is record sched_priority : int; -- scheduling priority diff --git a/gcc/ada/libgnarl/s-osinte__lynxos178e.ads b/gcc/ada/libgnarl/s-osinte__lynxos178e.ads index 6c5ebe37a06..20d983cabd7 100644 --- a/gcc/ada/libgnarl/s-osinte__lynxos178e.ads +++ b/gcc/ada/libgnarl/s-osinte__lynxos178e.ads @@ -453,8 +453,8 @@ package System.OS_Interface is pragma Import (C, pthread_setschedparam, "pthread_setschedparam"); function pthread_attr_setscope - (attr : access pthread_attr_t; - contentionscope : int) return int is (0); + (Unused_attr : access pthread_attr_t; + Unused_contentionscope : int) return int is (0); -- pthread_attr_setscope is not implemented in production mode function pthread_attr_setinheritsched diff --git a/gcc/ada/libgnarl/s-osinte__qnx.adb b/gcc/ada/libgnarl/s-osinte__qnx.adb index d37c7dbf759..acff8a710da 100644 --- a/gcc/ada/libgnarl/s-osinte__qnx.adb +++ b/gcc/ada/libgnarl/s-osinte__qnx.adb @@ -42,13 +42,25 @@ pragma Polling (Off); with Interfaces.C; use Interfaces.C; package body System.OS_Interface is + ----------------- + -- sigaltstack -- + ----------------- + + function sigaltstack + (ss : not null access stack_t; + oss : access stack_t) return int + is + pragma Unreferenced (ss, oss); + begin + return 0; + end sigaltstack; + -------------------- -- Get_Stack_Base -- -------------------- function Get_Stack_Base (thread : pthread_t) return Address is - pragma Warnings (Off, thread); - + pragma Unreferenced (thread); begin return Null_Address; end Get_Stack_Base; diff --git a/gcc/ada/libgnarl/s-osinte__qnx.ads b/gcc/ada/libgnarl/s-osinte__qnx.ads index 41e115641b3..36655a92b9b 100644 --- a/gcc/ada/libgnarl/s-osinte__qnx.ads +++ b/gcc/ada/libgnarl/s-osinte__qnx.ads @@ -301,7 +301,7 @@ package System.OS_Interface is function sigaltstack (ss : not null access stack_t; oss : access stack_t) return int - is (0); + with Inline; -- Not supported on QNX Alternate_Stack : aliased System.Address; @@ -315,7 +315,7 @@ package System.OS_Interface is -- Indicates whether the stack base is available on this target function Get_Stack_Base (thread : pthread_t) return System.Address - with Inline_Always; + with Inline; -- This is a dummy procedure to share some GNULLI files function Get_Page_Size return int; diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 1fdc2b0ab33..1b31048f11d 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -490,8 +490,8 @@ package body Sem_Ch6 is Orig_N : Node_Id; Ret : Node_Id; - Def_Id : Entity_Id := Empty; - Prev : Entity_Id; + Def_Id : Entity_Id := Empty; + Prev : Entity_Id; -- If the expression is a completion, Prev is the entity whose -- declaration is completed. Def_Id is needed to analyze the spec. @@ -783,11 +783,44 @@ package body Sem_Ch6 is Related_Nod => Original_Node (N)); end if; - -- If the return expression is a static constant, we suppress warning - -- messages on unused formals, which in most cases will be noise. + -- We must enforce checks for unreferenced formals in our newly + -- generated function, so we propagate the referenced flag from the + -- original spec to the new spec as well as setting Comes_From_Source. + + if Present (Parameter_Specifications (New_Spec)) then + declare + Form_New_Def : Entity_Id; + Form_New_Spec : Entity_Id; + Form_Old_Def : Entity_Id; + Form_Old_Spec : Entity_Id; + begin + + Form_New_Spec := First (Parameter_Specifications (New_Spec)); + Form_Old_Spec := First (Parameter_Specifications (Spec)); + + while Present (Form_New_Spec) and then Present (Form_Old_Spec) loop + Form_New_Def := Defining_Identifier (Form_New_Spec); + Form_Old_Def := Defining_Identifier (Form_Old_Spec); + + Set_Comes_From_Source (Form_New_Def, True); + + -- Because of the usefulness of unreferenced controlling + -- formals we exempt them from unreferenced warnings by marking + -- them as always referenced. + + Set_Referenced + (Form_Old_Def, + (Is_Formal (Form_Old_Def) + and then Is_Controlling_Formal (Form_Old_Def)) + or else Referenced (Form_Old_Def)); + -- or else Is_Dispatching_Operation + -- (Corresponding_Spec (New_Body))); - Set_Is_Trivial_Subprogram - (Defining_Entity (New_Body), Is_OK_Static_Expression (Expr)); + Next (Form_New_Spec); + Next (Form_Old_Spec); + end loop; + end; + end if; end Analyze_Expression_Function; ---------------------------------------- @@ -3906,7 +3939,13 @@ package body Sem_Ch6 is end if; end if; - if Spec_Id /= Body_Id then + -- In the case we are dealing with an expression function we check + -- the formals attached to the spec instead of the body - so we don't + -- reference body formals. + + if Spec_Id /= Body_Id + and then not Is_Expression_Function (Spec_Id) + then Reference_Body_Formals (Spec_Id, Body_Id); end if; @@ -4617,9 +4656,17 @@ package body Sem_Ch6 is end loop; end if; - -- Check references in body + -- Check references of the subprogram spec when we are dealing with + -- an expression function due to it having a generated body. + -- Otherwise, we simply check the formals of the subprogram body. - Check_References (Body_Id); + if Present (Spec_Id) + and then Is_Expression_Function (Spec_Id) + then + Check_References (Spec_Id); + else + Check_References (Body_Id); + end if; end; -- Check for nested subprogram, and mark outer level subprogram if so diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index c5c26fda0d9..00ef526f8c9 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2018-05-22 Justin Squirek + + * gnat.dg/warn14.adb: New testcase. + 2018-05-22 Hristian Kirtchev * gnat.dg/controlled8.adb: New testcase. diff --git a/gcc/testsuite/gnat.dg/warn14.adb b/gcc/testsuite/gnat.dg/warn14.adb new file mode 100644 index 00000000000..d7fbecebce3 --- /dev/null +++ b/gcc/testsuite/gnat.dg/warn14.adb @@ -0,0 +1,33 @@ +-- { dg-do compile } +-- { dg-options "-gnatwa" } + +procedure Warn14 is + + type E is record + P : Boolean; + end record; + + EE : Boolean := True; -- { dg-warning "variable \"EE\" is not referenced" } + + function F1 (I : Natural) return Natural is -- { dg-warning "function \"F1\" is not referenced" } + begin + return I; + end; + + function F2 (I : Natural) return Natural is (I); -- { dg-warning "function \"F2\" is not referenced" } + + function F3 (I : Natural) return Natural is (1); -- { dg-warning "function \"F3\" is not referenced|formal parameter \"I\" is not referenced" } + + function F7 (EE : E) return Boolean is (EE.P); -- { dg-warning "function \"F7\" is not referenced" } + + 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" } + end YY; + + XXX : YY.XX; + B : Natural := XXX.F4 (True); -- { dg-warning "variable \"B\" is not referenced" } +begin + null; +end; -- 2.30.2