mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-02-05 02:39:32 +08:00
Code Issues Packages Projects Releases Wiki Activity

sem_warn.ads, [...] (Publicly_Referenceable): Generic formals of a generic subprogram are not visible outside the body.

Browse Source 
2005-11-14  Ed Schonberg  <schonberg@adacore.com>
	    Robert Dewar  <dewar@adacore.com>

	* sem_warn.ads, sem_warn.adb (Publicly_Referenceable): Generic formals
	of a generic subprogram are not visible outside the body.
	(Set_Warning_Switch): New procedure (code to set warning mode moved
	here from Switch.C so that it can be shared by pragma processing.
	(Check_References): Special case warning for non-modified non-imported
	volatile objects.
	* par-prag.adb: Modify processing of pragma Warnings to accomodate new
	form with a string literal argument

From-SVN: r107008
This commit is contained in:
Ed Schonberg 2005-11-15 15:04:22 +01:00 committed by Arnaud Charlet
parent 21024a3946
commit b47efa9317
3 changed files with 243 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
gcc/ada/par-prag.adb
View File

@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2005 Free Software Foundation, Inc. -- -- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
@ -233,7 +233,7 @@ function Prag (Pragma_Node : Node_Id; Semi : Source_Ptr) return Node_Id is
elsif Id = Name_No_Dependence then elsif Id = Name_No_Dependence then
Set_Restriction_No_Dependence Set_Restriction_No_Dependence
(Unit => Expr, (Unit => Expr,
Warn => Prag_Id = Pragma_Restriction_Warnings); Warn => Prag_Id = Pragma_Restriction_Warnings);
end if; end if;
Next (Arg); Next (Arg);
@ -963,22 +963,28 @@ begin
--------------------- ---------------------
-- pragma Warnings (On | Off, [LOCAL_NAME]) -- pragma Warnings (On | Off, [LOCAL_NAME])
-- pragma Warnings (static_string_EXPRESSION);
-- The one argument case is processed by the parser, since it may -- The one argument ON/OFF case is processed by the parser, since it may
-- control parser warnings as well as semantic warnings, and in any -- control parser warnings as well as semantic warnings, and in any case
-- case we want to be absolutely sure that the range in the warnings -- we want to be absolutely sure that the range in the warnings table is
-- table is set well before any semantic analysis is performed. -- set well before any semantic analysis is performed.
when Pragma_Warnings => when Pragma_Warnings =>
if Arg_Count = 1 then if Arg_Count = 1 then
Check_No_Identifier (Arg1); Check_No_Identifier (Arg1);
Check_Arg_Is_On_Or_Off (Arg1);
if Chars (Expression (Arg1)) = Name_On then declare
Set_Warnings_Mode_On (Pragma_Sloc); Argx : constant Node_Id := Expression (Arg1);
else begin
Set_Warnings_Mode_Off (Pragma_Sloc); if Nkind (Argx) = N_Identifier then
end if; if Chars (Argx) = Name_On then
Set_Warnings_Mode_On (Pragma_Sloc);
elsif Chars (Argx) = Name_Off then
Set_Warnings_Mode_Off (Pragma_Sloc);
end if;
end if;
end;
end if; end if;
----------------------- -----------------------

219
gcc/ada/sem_warn.adb
View File

@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1999-2005 Free Software Foundation, Inc. -- -- Copyright (C) 1999-2005, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
@ -294,7 +294,20 @@ package body Sem_Warn is
or else List_Containing (Prev) or else List_Containing (Prev)
/= Generic_Formal_Declarations (P); /= Generic_Formal_Declarations (P);
-- if we reach a subprogram body, entity is not referenceable -- Similarly, the generic formals of a generic subprogram
-- are not accessible.
when N_Generic_Subprogram_Declaration =>
if Is_List_Member (Prev)
and then List_Containing (Prev) =
Generic_Formal_Declarations (P)
then
return False;
else
P := Parent (P);
end if;
-- If we reach a subprogram body, entity is not referenceable
-- unless it is the defining entity of the body. This will -- unless it is the defining entity of the body. This will
-- happen, e.g. when a function is an attribute renaming that -- happen, e.g. when a function is an attribute renaming that
-- is rewritten as a body. -- is rewritten as a body.
@ -451,8 +464,20 @@ package body Sem_Warn is
and then Is_True_Constant (E1) and then Is_True_Constant (E1)
and then not Generic_Package_Spec_Entity (E1) and then not Generic_Package_Spec_Entity (E1)
then then
Error_Msg_N -- A special case, if this variable is volatile and not
("& is not modified, could be declared constant?", E1); -- imported, it is not helpful to tell the programmer
-- to mark the variable as constant, since this would be
-- illegal by virtue of RM C.6(13).
if (Is_Volatile (E1) or else Has_Volatile_Components (E1))
and then not Is_Imported (E1)
then
Error_Msg_N
("& is not modified, volatile has no effect?", E1);
else
Error_Msg_N
("& is not modified, could be declared constant?", E1);
end if;
end if; end if;
-- Check for unset reference, note that we exclude access -- Check for unset reference, note that we exclude access
@ -1565,6 +1590,192 @@ package body Sem_Warn is
end loop; end loop;
end Output_Unreferenced_Messages; end Output_Unreferenced_Messages;
------------------------
-- Set_Warning_Switch --
------------------------
function Set_Warning_Switch (C : Character) return Boolean is
begin
case C is
when 'a' =>
Check_Unreferenced := True;
Check_Unreferenced_Formals := True;
Check_Withs := True;
Constant_Condition_Warnings := True;
Implementation_Unit_Warnings := True;
Ineffective_Inline_Warnings := True;
Warn_On_Ada_2005_Compatibility := True;
Warn_On_Bad_Fixed_Value := True;
Warn_On_Constant := True;
Warn_On_Export_Import := True;
Warn_On_Modified_Unread := True;
Warn_On_No_Value_Assigned := True;
Warn_On_Obsolescent_Feature := True;
Warn_On_Redundant_Constructs := True;
Warn_On_Unchecked_Conversion := True;
Warn_On_Unrecognized_Pragma := True;
when 'A' =>
Check_Unreferenced := False;
Check_Unreferenced_Formals := False;
Check_Withs := False;
Constant_Condition_Warnings := False;
Elab_Warnings := False;
Implementation_Unit_Warnings := False;
Ineffective_Inline_Warnings := False;
Warn_On_Ada_2005_Compatibility := False;
Warn_On_Bad_Fixed_Value := False;
Warn_On_Constant := False;
Warn_On_Dereference := False;
Warn_On_Export_Import := False;
Warn_On_Hiding := False;
Warn_On_Modified_Unread := False;
Warn_On_No_Value_Assigned := False;
Warn_On_Obsolescent_Feature := False;
Warn_On_Redundant_Constructs := False;
Warn_On_Unchecked_Conversion := False;
Warn_On_Unrecognized_Pragma := False;
when 'b' =>
Warn_On_Bad_Fixed_Value := True;
when 'B' =>
Warn_On_Bad_Fixed_Value := False;
when 'c' =>
Constant_Condition_Warnings := True;
when 'C' =>
Constant_Condition_Warnings := False;
when 'd' =>
Warn_On_Dereference := True;
when 'D' =>
Warn_On_Dereference := False;
when 'e' =>
Warning_Mode := Treat_As_Error;
when 'f' =>
Check_Unreferenced_Formals := True;
when 'F' =>
Check_Unreferenced_Formals := False;
when 'g' =>
Warn_On_Unrecognized_Pragma := True;
when 'G' =>
Warn_On_Unrecognized_Pragma := False;
when 'h' =>
Warn_On_Hiding := True;
when 'H' =>
Warn_On_Hiding := False;
when 'i' =>
Implementation_Unit_Warnings := True;
when 'I' =>
Implementation_Unit_Warnings := False;
when 'j' =>
Warn_On_Obsolescent_Feature := True;
when 'J' =>
Warn_On_Obsolescent_Feature := False;
when 'k' =>
Warn_On_Constant := True;
when 'K' =>
Warn_On_Constant := False;
when 'l' =>
Elab_Warnings := True;
when 'L' =>
Elab_Warnings := False;
when 'm' =>
Warn_On_Modified_Unread := True;
when 'M' =>
Warn_On_Modified_Unread := False;
when 'n' =>
Warning_Mode := Normal;
when 'o' =>
Address_Clause_Overlay_Warnings := True;
when 'O' =>
Address_Clause_Overlay_Warnings := False;
when 'p' =>
Ineffective_Inline_Warnings := True;
when 'P' =>
Ineffective_Inline_Warnings := False;
when 'r' =>
Warn_On_Redundant_Constructs := True;
when 'R' =>
Warn_On_Redundant_Constructs := False;
when 's' =>
Warning_Mode := Suppress;
when 'u' =>
Check_Unreferenced := True;
Check_Withs := True;
Check_Unreferenced_Formals := True;
when 'U' =>
Check_Unreferenced := False;
Check_Withs := False;
Check_Unreferenced_Formals := False;
when 'v' =>
Warn_On_No_Value_Assigned := True;
when 'V' =>
Warn_On_No_Value_Assigned := False;
when 'x' =>
Warn_On_Export_Import := True;
when 'X' =>
Warn_On_Export_Import := False;
when 'y' =>
Warn_On_Ada_2005_Compatibility := True;
when 'Y' =>
Warn_On_Ada_2005_Compatibility := False;
when 'z' =>
Warn_On_Unchecked_Conversion := True;
when 'Z' =>
Warn_On_Unchecked_Conversion := False;
-- Allow and ignore 'w' so that the old
-- format (e.g. -gnatwuwl) will work.
when 'w' =>
null;
when others =>
return False;
end case;
return True;
end Set_Warning_Switch;
----------------------------- -----------------------------
-- Warn_On_Known_Condition -- -- Warn_On_Known_Condition --
----------------------------- -----------------------------

11
gcc/ada/sem_warn.ads
View File

@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1999-2001 Free Software Foundation, Inc. -- -- Copyright (C) 1999-2005, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
@ -32,6 +32,15 @@ with Types; use Types;
package Sem_Warn is package Sem_Warn is
--------------------
-- Initialization --
--------------------
function Set_Warning_Switch (C : Character) return Boolean;
-- This function sets the warning switch or switches corresponding to
-- the given character. It is used for processing a -gnatw switch on the
-- command line, or a string literal in pragma Warnings.
------------------------------------------ ------------------------------------------
-- Routines to Handle Unused References -- -- Routines to Handle Unused References --
------------------------------------------ ------------------------------------------