@@ -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
@@ -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
@@ -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;
@@ -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;
@@ -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
new file mode 100644
@@ -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;