OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

einfo.adb (Has_Pragma_Unused): Create this function as a setter for a new flag294 (Set_Has_Pragma_Unused):... 

2016-07-04  Justin Squirek  <squirek@adacore.com>

	* einfo.adb (Has_Pragma_Unused): Create this function as a setter
	for a new flag294 (Set_Has_Pragma_Unused): Create this procedure
	as a getter for flag294 (Write_Entity_Flags): Register the new
	flag with an alias
	* einfo.ads Add comment documenting Has_Pragma_Unused (flag294)
	and subsequent getter and setter declarations.
	* lib-xref.adb (Generate_Reference): Recognize Has_Pragma_Unused
	flag to print appropriate warning messages.
	* par-prag.adb (Prag): Classify Pragma_Unused into "All Other
	Pragmas."
	* snames.ads-tmpl Add a new name to the name constants and a
	new pramga to Pragma_Id for pramga Unused.
	* sem_prag.adb (Analyze_Pragma): Create case for Pragma_Unused
	and move the block for Pragma_Unmodified and Pragma_Unreferenced
	out and into local subprograms.
	(Analyze_Unmodified, Analyze_Unreferenced): From the old pragma blocks
	that have been separated in to local subprograms add a parameter to
	indicate the if they are being called in the context of Pragma_Unused
	and handle it accordingly.
	(Is_Non_Significant_Pragma_Reference): Add an entry for Pragma_Unused
	and correct the position of Pragma_Unevaluated_Use_Of_Old.
	* sem_util.adb (Note_Possible_Modification): Recognize
	Has_Pragma_Unused flag to print appropriate warning messages.

From-SVN: r237961
This commit is contained in:
Justin Squirek 2016-07-04 10:05:53 +00:00 committed by Arnaud Charlet
parent 002e3d16cb
commit 9d1d00ca24
8 changed files with 399 additions and 250 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
gcc/ada/ChangeLog
View File

@ -1,3 +1,29 @@
2016-07-04 Justin Squirek <squirek@adacore.com>
* einfo.adb (Has_Pragma_Unused): Create this function as a setter
for a new flag294 (Set_Has_Pragma_Unused): Create this procedure
as a getter for flag294 (Write_Entity_Flags): Register the new
flag with an alias
* einfo.ads Add comment documenting Has_Pragma_Unused (flag294)
and subsequent getter and setter declarations.
* lib-xref.adb (Generate_Reference): Recognize Has_Pragma_Unused
flag to print appropriate warning messages.
* par-prag.adb (Prag): Classify Pragma_Unused into "All Other
Pragmas."
* snames.ads-tmpl Add a new name to the name constants and a
new pramga to Pragma_Id for pramga Unused.
* sem_prag.adb (Analyze_Pragma): Create case for Pragma_Unused
and move the block for Pragma_Unmodified and Pragma_Unreferenced
out and into local subprograms.
(Analyze_Unmodified, Analyze_Unreferenced): From the old pragma blocks
that have been separated in to local subprograms add a parameter to
indicate the if they are being called in the context of Pragma_Unused
and handle it accordingly.
(Is_Non_Significant_Pragma_Reference): Add an entry for Pragma_Unused
and correct the position of Pragma_Unevaluated_Use_Of_Old.
* sem_util.adb (Note_Possible_Modification): Recognize
Has_Pragma_Unused flag to print appropriate warning messages.
2016-07-04 Ed Schonberg <schonberg@adacore.com>
* freeze.adb (Check_Inherited_Conditions): Perform two passes over

13
gcc/ada/einfo.adb
View File

@ -608,8 +608,8 @@ package body Einfo is
-- Has_Inherited_Invariants Flag291
-- Is_Partial_Invariant_Procedure Flag292
-- Is_Actual_Subtype Flag293
-- Has_Pragma_Unused Flag294
-- (unused) Flag294
-- (unused) Flag295
-- (unused) Flag296
-- (unused) Flag297
@ -1761,6 +1761,11 @@ package body Einfo is
return Flag212 (Id);
end Has_Pragma_Unreferenced_Objects;
function Has_Pragma_Unused (Id : E) return B is
begin
return Flag294 (Id);
end Has_Pragma_Unused;
function Has_Predicates (Id : E) return B is
begin
pragma Assert (Is_Type (Id));
@ -4768,6 +4773,11 @@ package body Einfo is
Set_Flag212 (Id, V);
end Set_Has_Pragma_Unreferenced_Objects;
procedure Set_Has_Pragma_Unused (Id : E; V : B := True) is
begin
Set_Flag294 (Id, V);
end Set_Has_Pragma_Unused;
procedure Set_Has_Predicates (Id : E; V : B := True) is
begin
pragma Assert (Is_Type (Id) or else Ekind (Id) = E_Void);
@ -9162,6 +9172,7 @@ package body Einfo is
W ("Has_Pragma_Unmodified", Flag233 (Id));
W ("Has_Pragma_Unreferenced", Flag180 (Id));
W ("Has_Pragma_Unreferenced_Objects", Flag212 (Id));
W ("Has_Pragma_Unused", Flag294 (Id));
W ("Has_Predicates", Flag250 (Id));
W ("Has_Primitive_Operations", Flag120 (Id));
W ("Has_Private_Ancestor", Flag151 (Id));

21
gcc/ada/einfo.ads
View File

@ -1902,12 +1902,19 @@ package Einfo is
-- that clients should generally not test this flag directly, but instead
-- use function Has_Unreferenced.
-- ??? this real description was clobbered
-- Has_Pragma_Unreferenced_Objects (Flag212)
-- Defined in type and subtype entities. Set if a valid pragma
-- Unreferenced_Objects applies to the type, indicating that no warning
-- should be given for objects of such a type for being unreferenced
-- (but unlike the case with pragma Unreferenced, it is ok to reference
-- such an object and no warning is generated.
-- Defined in all entities. Set if a valid pragma Unused applies to an
-- entity, indicating that warnings should be given if the entity is
-- modified or referenced. This pragma is equivalent to a pair of
-- Unmodified and Unreferenced pragmas.
-- Has_Pragma_Unused (Flag294)
-- Defined in all entries. Set if a valid pragma Unused applies to a
-- variable or entity, indicating that warnings should not be given if
-- it is never modified or referenced. Note: This pragma is exactly
-- equivalent Unmodified and Unreference combined.
-- Has_Predicates (Flag250)
-- Defined in type and subtype entities. Set if a pragma Predicate or
@ -5397,6 +5404,7 @@ package Einfo is
-- Has_Pragma_Thread_Local_Storage (Flag169)
-- Has_Pragma_Unmodified (Flag233)
-- Has_Pragma_Unreferenced (Flag180)
-- Has_Pragma_Unused (Flag294)
-- Has_Private_Declaration (Flag155)
-- Has_Qualified_Name (Flag161)
-- Has_Stream_Size_Clause (Flag184)
@ -6976,6 +6984,7 @@ package Einfo is
function Has_Pragma_Unmodified (Id : E) return B;
function Has_Pragma_Unreferenced (Id : E) return B;
function Has_Pragma_Unreferenced_Objects (Id : E) return B;
function Has_Pragma_Unused (Id : E) return B;
function Has_Predicates (Id : E) return B;
function Has_Primitive_Operations (Id : E) return B;
function Has_Private_Ancestor (Id : E) return B;
@ -7649,6 +7658,7 @@ package Einfo is
procedure Set_Has_Pragma_Unmodified (Id : E; V : B := True);
procedure Set_Has_Pragma_Unreferenced (Id : E; V : B := True);
procedure Set_Has_Pragma_Unreferenced_Objects (Id : E; V : B := True);
procedure Set_Has_Pragma_Unused (Id : E; V : B := True);
procedure Set_Has_Predicates (Id : E; V : B := True);
procedure Set_Has_Primitive_Operations (Id : E; V : B := True);
procedure Set_Has_Private_Ancestor (Id : E; V : B := True);
@ -8439,6 +8449,7 @@ package Einfo is
pragma Inline (Has_Pragma_Unmodified);
pragma Inline (Has_Pragma_Unreferenced);
pragma Inline (Has_Pragma_Unreferenced_Objects);
pragma Inline (Has_Pragma_Unused);
pragma Inline (Has_Predicates);
pragma Inline (Has_Primitive_Operations);
pragma Inline (Has_Private_Ancestor);

10
gcc/ada/lib-xref.adb
View File

@ -841,6 +841,8 @@ package body Lib.Xref is
-- Check for pragma Unreferenced given and reference is within
-- this source unit (occasion for possible warning to be issued).
-- Note that the entity may be marked as unreferenced by pragma
-- Unused.
if Has_Unreferenced (E)
and then In_Same_Extended_Unit (E, N)
@ -875,8 +877,13 @@ package body Lib.Xref is
BE := First_Entity (Current_Scope);
while Present (BE) loop
if Chars (BE) = Chars (E) then
if Has_Pragma_Unused (E) then
Error_Msg_NE -- CODEFIX
("??pragma Unused given for&!", N, BE);
else
Error_Msg_NE -- CODEFIX
("??pragma Unreferenced given for&!", N, BE);
end if;
exit;
end if;
@ -886,6 +893,9 @@ package body Lib.Xref is
-- Here we issue the warning, since this is a real reference
elsif Has_Pragma_Unused (E) then
Error_Msg_NE -- CODEFIX
("??pragma Unused given for&!", N, E);
else
Error_Msg_NE -- CODEFIX
("??pragma Unreferenced given for&!", N, E);

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

@ -1487,6 +1487,7 @@ begin
Pragma_Unreferenced_Objects |
Pragma_Unreserve_All_Interrupts |
Pragma_Unsuppress |
Pragma_Unused |
Pragma_Use_VADS_Size |
Pragma_Volatile |
Pragma_Volatile_Components |

553
gcc/ada/sem_prag.adb
View File

@ -3502,6 +3502,16 @@ package body Sem_Prag is
-- related subprogram. Body_Id is the entity of the subprogram body.
-- Flag Legal is set when the pragma is legal.
procedure Analyze_Unmodified_Or_Unused (Is_Unused : Boolean := False);
-- Perform full analysis of pragma Unmodified and the write aspect of
-- pragma Unused. Flag Is_Unused should be set when verifying the
-- semantics of pragma Unused.
procedure Analyze_Unreferenced_Or_Unused (Is_Unused : Boolean := False);
-- Perform full analysis of pragma Unreferenced and the read aspect of
-- pragma Unused. Flag Is_Unused should be set when verifying the
-- semantics of pragma Unused.
procedure Check_Ada_83_Warning;
-- Issues a warning message for the current pragma if operating in Ada
-- 83 mode (used for language pragmas that are not a standard part of
@ -4465,6 +4475,274 @@ package body Sem_Prag is
end if;
end Analyze_Refined_Depends_Global_Post;
----------------------------------
-- Analyze_Unmodified_Or_Unused --
----------------------------------
procedure Analyze_Unmodified_Or_Unused (Is_Unused : Boolean := False) is
Arg : Node_Id;
Arg_Expr : Node_Id;
Arg_Id : Entity_Id;
Ghost_Error_Posted : Boolean := False;
-- Flag set when an error concerning the illegal mix of Ghost and
-- non-Ghost variables is emitted.
Ghost_Id : Entity_Id := Empty;
-- The entity of the first Ghost variable encountered while
-- processing the arguments of the pragma.
begin
GNAT_Pragma;
Check_At_Least_N_Arguments (1);
-- Loop through arguments
Arg := Arg1;
while Present (Arg) loop
Check_No_Identifier (Arg);
-- Note: the analyze call done by Check_Arg_Is_Local_Name will
-- in fact generate reference, so that the entity will have a
-- reference, which will inhibit any warnings about it not
-- being referenced, and also properly show up in the ali file
-- as a reference. But this reference is recorded before the
-- Has_Pragma_Unreferenced flag is set, so that no warning is
-- generated for this reference.
Check_Arg_Is_Local_Name (Arg);
Arg_Expr := Get_Pragma_Arg (Arg);
if Is_Entity_Name (Arg_Expr) then
Arg_Id := Entity (Arg_Expr);
-- Skip processing the argument if already flagged
if Is_Assignable (Arg_Id)
and then not Has_Pragma_Unmodified (Arg_Id)
and then not Has_Pragma_Unused (Arg_Id)
then
Set_Has_Pragma_Unmodified (Arg_Id);
if Is_Unused then
Set_Has_Pragma_Unused (Arg_Id);
end if;
-- A pragma that applies to a Ghost entity becomes Ghost for
-- the purposes of legality checks and removal of ignored
-- Ghost code.
Mark_Pragma_As_Ghost (N, Arg_Id);
-- Capture the entity of the first Ghost variable being
-- processed for error detection purposes.
if Is_Ghost_Entity (Arg_Id) then
if No (Ghost_Id) then
Ghost_Id := Arg_Id;
end if;
-- Otherwise the variable is non-Ghost. It is illegal to mix
-- references to Ghost and non-Ghost entities
-- (SPARK RM 6.9).
elsif Present (Ghost_Id)
and then not Ghost_Error_Posted
then
Ghost_Error_Posted := True;
Error_Msg_Name_1 := Pname;
Error_Msg_N
("pragma % cannot mention ghost and non-ghost "
& "variables", N);
Error_Msg_Sloc := Sloc (Ghost_Id);
Error_Msg_NE ("\& # declared as ghost", N, Ghost_Id);
Error_Msg_Sloc := Sloc (Arg_Id);
Error_Msg_NE ("\& # declared as non-ghost", N, Arg_Id);
end if;
-- Warn if already flagged as Unused or Unmodified
elsif Has_Pragma_Unmodified (Arg_Id) then
if Has_Pragma_Unused (Arg_Id) then
Error_Msg_NE
("??pragma Unused given for &!", Arg_Expr, Arg_Id);
else
Error_Msg_NE
("??pragma Unmodified given for &!", Arg_Expr, Arg_Id);
end if;
-- Otherwise the pragma referenced an illegal entity
else
Error_Pragma_Arg
("pragma% can only be applied to a variable", Arg_Expr);
end if;
end if;
Next (Arg);
end loop;
end Analyze_Unmodified_Or_Unused;
-----------------------------------
-- Analyze_Unreference_Or_Unused --
-----------------------------------
procedure Analyze_Unreferenced_Or_Unused
(Is_Unused : Boolean := False)
is
Arg : Node_Id;
Arg_Expr : Node_Id;
Arg_Id : Entity_Id;
Citem : Node_Id;
Ghost_Error_Posted : Boolean := False;
-- Flag set when an error concerning the illegal mix of Ghost and
-- non-Ghost names is emitted.
Ghost_Id : Entity_Id := Empty;
-- The entity of the first Ghost name encountered while processing
-- the arguments of the pragma.
begin
GNAT_Pragma;
Check_At_Least_N_Arguments (1);
-- Check case of appearing within context clause
if not Is_Unused and then Is_In_Context_Clause then
-- The arguments must all be units mentioned in a with clause in
-- the same context clause. Note that Par.Prag already checked
-- that the arguments are either identifiers or selected
-- components.
Arg := Arg1;
while Present (Arg) loop
Citem := First (List_Containing (N));
while Citem /= N loop
Arg_Expr := Get_Pragma_Arg (Arg);
if Nkind (Citem) = N_With_Clause
and then Same_Name (Name (Citem), Arg_Expr)
then
Set_Has_Pragma_Unreferenced
(Cunit_Entity
(Get_Source_Unit
(Library_Unit (Citem))));
Set_Elab_Unit_Name (Arg_Expr, Name (Citem));
exit;
end if;
Next (Citem);
end loop;
if Citem = N then
Error_Pragma_Arg
("argument of pragma% is not withed unit", Arg);
end if;
Next (Arg);
end loop;
-- Case of not in list of context items
else
Arg := Arg1;
while Present (Arg) loop
Check_No_Identifier (Arg);
-- Note: the analyze call done by Check_Arg_Is_Local_Name will
-- in fact generate reference, so that the entity will have a
-- reference, which will inhibit any warnings about it not
-- being referenced, and also properly show up in the ali file
-- as a reference. But this reference is recorded before the
-- Has_Pragma_Unreferenced flag is set, so that no warning is
-- generated for this reference.
Check_Arg_Is_Local_Name (Arg);
Arg_Expr := Get_Pragma_Arg (Arg);
if Is_Entity_Name (Arg_Expr) then
Arg_Id := Entity (Arg_Expr);
-- Warn if already flagged as Unused or Unreferenced and
-- skip processing the argument.
if Has_Pragma_Unreferenced (Arg_Id) then
if Has_Pragma_Unused (Arg_Id) then
Error_Msg_NE
("??pragma Unused given for &!", Arg_Expr, Arg_Id);
else
Error_Msg_NE
("??pragma Unreferenced given for &!", Arg_Expr,
Arg_Id);
end if;
-- Apply Unreferenced to the entity
else
-- If the entity is overloaded, the pragma applies to the
-- most recent overloading, as documented. In this case,
-- name resolution does not generate a reference, so it
-- must be done here explicitly.
if Is_Overloaded (Arg_Expr) then
Generate_Reference (Arg_Id, N);
end if;
Set_Has_Pragma_Unreferenced (Arg_Id);
if Is_Unused then
Set_Has_Pragma_Unused (Arg_Id);
end if;
-- A pragma that applies to a Ghost entity becomes Ghost
-- for the purposes of legality checks and removal of
-- ignored Ghost code.
Mark_Pragma_As_Ghost (N, Arg_Id);
-- Capture the entity of the first Ghost name being
-- processed for error detection purposes.
if Is_Ghost_Entity (Arg_Id) then
if No (Ghost_Id) then
Ghost_Id := Arg_Id;
end if;
-- Otherwise the name is non-Ghost. It is illegal to mix
-- references to Ghost and non-Ghost entities
-- (SPARK RM 6.9).
elsif Present (Ghost_Id)
and then not Ghost_Error_Posted
then
Ghost_Error_Posted := True;
Error_Msg_Name_1 := Pname;
Error_Msg_N
("pragma % cannot mention ghost and non-ghost "
& "names", N);
Error_Msg_Sloc := Sloc (Ghost_Id);
Error_Msg_NE
("\& # declared as ghost", N, Ghost_Id);
Error_Msg_Sloc := Sloc (Arg_Id);
Error_Msg_NE
("\& # declared as non-ghost", N, Arg_Id);
end if;
end if;
end if;
Next (Arg);
end loop;
end if;
end Analyze_Unreferenced_Or_Unused;
--------------------------
-- Check_Ada_83_Warning --
--------------------------
@ -22270,6 +22548,30 @@ package body Sem_Prag is
Set_Is_Unchecked_Union (Base_Type (Typ));
end Unchecked_Union;
----------------------------
-- Unevaluated_Use_Of_Old --
----------------------------
-- pragma Unevaluated_Use_Of_Old (Error | Warn | Allow);
when Pragma_Unevaluated_Use_Of_Old =>
GNAT_Pragma;
Check_Arg_Count (1);
Check_No_Identifiers;
Check_Arg_Is_One_Of (Arg1, Name_Error, Name_Warn, Name_Allow);
-- Suppress/Unsuppress can appear as a configuration pragma, or in
-- a declarative part or a package spec.
if not Is_Configuration_Pragma then
Check_Is_In_Decl_Part_Or_Package_Spec;
end if;
-- Store proper setting of Uneval_Old
Get_Name_String (Chars (Get_Pragma_Arg (Arg1)));
Uneval_Old := Fold_Upper (Name_Buffer (1));
------------------------
-- Unimplemented_Unit --
------------------------
@ -22283,8 +22585,7 @@ package body Sem_Prag is
when Pragma_Unimplemented_Unit => Unimplemented_Unit : declare
Cunitent : constant Entity_Id :=
Cunit_Entity (Get_Source_Unit (Loc));
Ent_Kind : constant Entity_Kind :=
Ekind (Cunitent);
Ent_Kind : constant Entity_Kind := Ekind (Cunitent);
begin
GNAT_Pragma;
@ -22350,92 +22651,8 @@ package body Sem_Prag is
-- pragma Unmodified (LOCAL_NAME {, LOCAL_NAME});
when Pragma_Unmodified => Unmodified : declare
Arg : Node_Id;
Arg_Expr : Node_Id;
Arg_Id : Entity_Id;
Ghost_Error_Posted : Boolean := False;
-- Flag set when an error concerning the illegal mix of Ghost and
-- non-Ghost variables is emitted.
Ghost_Id : Entity_Id := Empty;
-- The entity of the first Ghost variable encountered while
-- processing the arguments of the pragma.
begin
GNAT_Pragma;
Check_At_Least_N_Arguments (1);
-- Loop through arguments
Arg := Arg1;
while Present (Arg) loop
Check_No_Identifier (Arg);
-- Note: the analyze call done by Check_Arg_Is_Local_Name will
-- in fact generate reference, so that the entity will have a
-- reference, which will inhibit any warnings about it not
-- being referenced, and also properly show up in the ali file
-- as a reference. But this reference is recorded before the
-- Has_Pragma_Unreferenced flag is set, so that no warning is
-- generated for this reference.
Check_Arg_Is_Local_Name (Arg);
Arg_Expr := Get_Pragma_Arg (Arg);
if Is_Entity_Name (Arg_Expr) then
Arg_Id := Entity (Arg_Expr);
if Is_Assignable (Arg_Id) then
Set_Has_Pragma_Unmodified (Arg_Id);
-- A pragma that applies to a Ghost entity becomes Ghost
-- for the purposes of legality checks and removal of
-- ignored Ghost code.
Mark_Pragma_As_Ghost (N, Arg_Id);
-- Capture the entity of the first Ghost variable being
-- processed for error detection purposes.
if Is_Ghost_Entity (Arg_Id) then
if No (Ghost_Id) then
Ghost_Id := Arg_Id;
end if;
-- Otherwise the variable is non-Ghost. It is illegal
-- to mix references to Ghost and non-Ghost entities
-- (SPARK RM 6.9).
elsif Present (Ghost_Id)
and then not Ghost_Error_Posted
then
Ghost_Error_Posted := True;
Error_Msg_Name_1 := Pname;
Error_Msg_N
("pragma % cannot mention ghost and non-ghost "
& "variables", N);
Error_Msg_Sloc := Sloc (Ghost_Id);
Error_Msg_NE ("\& # declared as ghost", N, Ghost_Id);
Error_Msg_Sloc := Sloc (Arg_Id);
Error_Msg_NE ("\& # declared as non-ghost", N, Arg_Id);
end if;
-- Otherwise the pragma referenced an illegal entity
else
Error_Pragma_Arg
("pragma% can only be applied to a variable", Arg_Expr);
end if;
end if;
Next (Arg);
end loop;
end Unmodified;
when Pragma_Unmodified =>
Analyze_Unmodified_Or_Unused;
------------------
-- Unreferenced --
@ -22447,133 +22664,8 @@ package body Sem_Prag is
-- pragma Unreferenced (library_unit_NAME {, library_unit_NAME}
when Pragma_Unreferenced => Unreferenced : declare
Arg : Node_Id;
Arg_Expr : Node_Id;
Arg_Id : Entity_Id;
Citem : Node_Id;
Ghost_Error_Posted : Boolean := False;
-- Flag set when an error concerning the illegal mix of Ghost and
-- non-Ghost names is emitted.
Ghost_Id : Entity_Id := Empty;
-- The entity of the first Ghost name encountered while processing
-- the arguments of the pragma.
begin
GNAT_Pragma;
Check_At_Least_N_Arguments (1);
-- Check case of appearing within context clause
if Is_In_Context_Clause then
-- The arguments must all be units mentioned in a with clause
-- in the same context clause. Note we already checked (in
-- Par.Prag) that the arguments are either identifiers or
-- selected components.
Arg := Arg1;
while Present (Arg) loop
Citem := First (List_Containing (N));
while Citem /= N loop
Arg_Expr := Get_Pragma_Arg (Arg);
if Nkind (Citem) = N_With_Clause
and then Same_Name (Name (Citem), Arg_Expr)
then
Set_Has_Pragma_Unreferenced
(Cunit_Entity
(Get_Source_Unit
(Library_Unit (Citem))));
Set_Elab_Unit_Name (Arg_Expr, Name (Citem));
exit;
end if;
Next (Citem);
end loop;
if Citem = N then
Error_Pragma_Arg
("argument of pragma% is not withed unit", Arg);
end if;
Next (Arg);
end loop;
-- Case of not in list of context items
else
Arg := Arg1;
while Present (Arg) loop
Check_No_Identifier (Arg);
-- Note: the analyze call done by Check_Arg_Is_Local_Name
-- will in fact generate reference, so that the entity will
-- have a reference, which will inhibit any warnings about
-- it not being referenced, and also properly show up in the
-- ali file as a reference. But this reference is recorded
-- before the Has_Pragma_Unreferenced flag is set, so that
-- no warning is generated for this reference.
Check_Arg_Is_Local_Name (Arg);
Arg_Expr := Get_Pragma_Arg (Arg);
if Is_Entity_Name (Arg_Expr) then
Arg_Id := Entity (Arg_Expr);
-- If the entity is overloaded, the pragma applies to the
-- most recent overloading, as documented. In this case,
-- name resolution does not generate a reference, so it
-- must be done here explicitly.
if Is_Overloaded (Arg_Expr) then
Generate_Reference (Arg_Id, N);
end if;
Set_Has_Pragma_Unreferenced (Arg_Id);
-- A pragma that applies to a Ghost entity becomes Ghost
-- for the purposes of legality checks and removal of
-- ignored Ghost code.
Mark_Pragma_As_Ghost (N, Arg_Id);
-- Capture the entity of the first Ghost name being
-- processed for error detection purposes.
if Is_Ghost_Entity (Arg_Id) then
if No (Ghost_Id) then
Ghost_Id := Arg_Id;
end if;
-- Otherwise the name is non-Ghost. It is illegal to mix
-- references to Ghost and non-Ghost entities
-- (SPARK RM 6.9).
elsif Present (Ghost_Id)
and then not Ghost_Error_Posted
then
Ghost_Error_Posted := True;
Error_Msg_Name_1 := Pname;
Error_Msg_N
("pragma % cannot mention ghost and non-ghost names",
N);
Error_Msg_Sloc := Sloc (Ghost_Id);
Error_Msg_NE ("\& # declared as ghost", N, Ghost_Id);
Error_Msg_Sloc := Sloc (Arg_Id);
Error_Msg_NE ("\& # declared as non-ghost", N, Arg_Id);
end if;
end if;
Next (Arg);
end loop;
end if;
end Unreferenced;
when Pragma_Unreferenced =>
Analyze_Unreferenced_Or_Unused;
--------------------------
-- Unreferenced_Objects --
@ -22681,29 +22773,15 @@ package body Sem_Prag is
Ada_2005_Pragma;
Process_Suppress_Unsuppress (Suppress_Case => False);
----------------------------
-- Unevaluated_Use_Of_Old --
----------------------------
------------
-- Unused --
------------
-- pragma Unevaluated_Use_Of_Old (Error | Warn | Allow);
-- pragma Unused (LOCAL_NAME {, LOCAL_NAME});
when Pragma_Unevaluated_Use_Of_Old =>
GNAT_Pragma;
Check_Arg_Count (1);
Check_No_Identifiers;
Check_Arg_Is_One_Of (Arg1, Name_Error, Name_Warn, Name_Allow);
-- Suppress/Unsuppress can appear as a configuration pragma, or in
-- a declarative part or a package spec.
if not Is_Configuration_Pragma then
Check_Is_In_Decl_Part_Or_Package_Spec;
end if;
-- Store proper setting of Uneval_Old
Get_Name_String (Chars (Get_Pragma_Arg (Arg1)));
Uneval_Old := Fold_Upper (Name_Buffer (1));
when Pragma_Unused =>
Analyze_Unmodified_Or_Unused (Is_Unused => True);
Analyze_Unreferenced_Or_Unused (Is_Unused => True);
-------------------
-- Use_VADS_Size --
@ -28378,6 +28456,7 @@ package body Sem_Prag is
Pragma_Type_Invariant => -1,
Pragma_Type_Invariant_Class => -1,
Pragma_Unchecked_Union => 0,
Pragma_Unevaluated_Use_Of_Old => 0,
Pragma_Unimplemented_Unit => 0,
Pragma_Universal_Aliasing => 0,
Pragma_Universal_Data => 0,
@ -28386,7 +28465,7 @@ package body Sem_Prag is
Pragma_Unreferenced_Objects => 0,
Pragma_Unreserve_All_Interrupts => 0,
Pragma_Unsuppress => 0,
Pragma_Unevaluated_Use_Of_Old => 0,
Pragma_Unused => 0,
Pragma_Use_VADS_Size => 0,
Pragma_Validity_Checks => 0,
Pragma_Volatile => 0,

13
gcc/ada/sem_util.adb
View File

@ -17618,11 +17618,20 @@ package body Sem_Util is
if Comes_From_Source (Exp)
or else Modification_Comes_From_Source
then
-- Give warning if pragma unmodified given and we are
-- Give warning if pragma unmodified is given and we are
-- sure this is a modification.
if Has_Pragma_Unmodified (Ent) and then Sure then
Error_Msg_NE ("??pragma Unmodified given for &!", N, Ent);
-- Note that the entity may be present only as a result
-- of pragma Unused.
if Has_Pragma_Unused (Ent) then
Error_Msg_NE ("??pragma Unused given for &!", N, Ent);
else
Error_Msg_NE
("??pragma Unmodified given for &!", N, Ent);
end if;
end if;
Set_Never_Set_In_Source (Ent, False);

2
gcc/ada/snames.ads-tmpl
View File

@ -653,6 +653,7 @@ package Snames is
Name_Unreferenced : constant Name_Id := N + $; -- GNAT
Name_Unreferenced_Objects : constant Name_Id := N + $; -- GNAT
Name_Unreserve_All_Interrupts : constant Name_Id := N + $; -- GNAT
Name_Unused : constant Name_Id := N + $; -- GNAT
Name_Volatile : constant Name_Id := N + $;
Name_Volatile_Components : constant Name_Id := N + $;
Name_Volatile_Full_Access : constant Name_Id := N + $; -- GNAT
@ -1965,6 +1966,7 @@ package Snames is
Pragma_Unreferenced,
Pragma_Unreferenced_Objects,
Pragma_Unreserve_All_Interrupts,
Pragma_Unused,
Pragma_Volatile,
Pragma_Volatile_Components,
Pragma_Volatile_Full_Access,