[Ada] Missing warning for unreferenced formals in expression functions
authorJustin Squirek <squirek@adacore.com>
Tue, 22 May 2018 13:27:14 +0000 (13:27 +0000)
committerPierre-Marie de Rodat <pmderodat@gcc.gnu.org>
Tue, 22 May 2018 13:27:14 +0000 (13:27 +0000)
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  <squirek@adacore.com>

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
gcc/ada/libgnarl/s-osinte__android.ads
gcc/ada/libgnarl/s-osinte__lynxos178e.ads
gcc/ada/libgnarl/s-osinte__qnx.adb
gcc/ada/libgnarl/s-osinte__qnx.ads
gcc/ada/sem_ch6.adb
gcc/testsuite/ChangeLog
gcc/testsuite/gnat.dg/warn14.adb [new file with mode: 0644]

index 1f7cba903c765debc932ddeada2e64a1ec554efa..11a74a74a167d41857d8684983baa867f47e7bbb 100644 (file)
@@ -1,3 +1,17 @@
+2018-05-22  Justin Squirek  <squirek@adacore.com>
+
+       * 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  <rupp@adacore.com>
 
        * init.c (HAVE_ADJUST_CONTEXT_FOR_RAISE): Don't define on VxWorks7 for
index 67f487e7278ceba237b73204c86c3e1619559275..98257172fe6f5df2ae0ace53ab9503215deee2da 100644 (file)
@@ -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
index 6c5ebe37a0650034183f98a2a438a7334b6e4ffb..20d983cabd7257f9ec87d26b21a342a6123901f9 100644 (file)
@@ -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
index d37c7dbf75984492a2203931fd04c86ef5e89097..acff8a710dacf7d69547aaa609dc2e580c609a44 100644 (file)
@@ -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;
index 41e115641b32ea97a4381329986b9282edd77e9f..36655a92b9ba540ee81f91201f08a5e21335352c 100644 (file)
@@ -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;
index 1fdc2b0ab33c74ecc73d442ddf2c6ad57e1bf0ee..1b31048f11d4b6bea437b56e29d72adcea3f5372 100644 (file)
@@ -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
index c5c26fda0d92fb6bce21eb1d486724b68d098eb9..00ef526f8c91959b1d8c058e5ed18da806ff5da1 100644 (file)
@@ -1,3 +1,7 @@
+2018-05-22  Justin Squirek  <squirek@adacore.com>
+
+       * gnat.dg/warn14.adb: New testcase.
+
 2018-05-22  Hristian Kirtchev  <kirtchev@adacore.com>
 
        * 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 (file)
index 0000000..d7fbece
--- /dev/null
@@ -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;