Two pragmas exist - Unmodified and Unreferenced which issue warnings if the
respective entities contained get written or read repectivly. Additionally,
pragma Unreferenced will surpress compiler generated warnings for unread
variables. However, this can lead to confusion about pragma Unreferenced
whereby the assumed meaning would encompass writing as well as reading and
to achive this effect both pragmas would have to be utilized which is
inefficient. This patch adds a new pragma "Unused" to serve as a combination
of Unmodified and Unreferenced.
------------
-- Source --
------------
-- main.adb
with Ada.Text_IO;
-- Context clause
pragma Unused (Ada.Text_IO); -- Warn Unused
pragma Unmodified (Ada.Text_IO); -- Warn Unmodified
pragma Unreferenced (Ada.Text_IO); -- Valid
procedure Main is
-- Improper use
X, Y, Z : Boolean := False;
-- Non-variable
procedure Test is begin null; end;
pragma Unmodified (Test); -- Warn Unmodified
pragma Unused (Test); -- Warn Unused
pragma Unreferenced (Test); -- Valid
-- Equivalence of Unused to Unmodified + Unreferenced
pragma Unmodified (X); -- Valid
pragma Unmodified (X); -- Warn Unmodified
pragma Unreferenced (X); -- Valid
pragma Unused (Y); -- Valid
-- Duplicate error messages
pragma Unreferenced (X); -- Warn Unreferenced
pragma Unused (X); -- Warn Unmodified and Unreferenced
pragma Unused (Y); -- Warn Unused
pragma Unmodified (Y); -- Warn Unused
pragma Unreferenced (Y); -- Warn Unused
-- Proper use
A, B, C, D : Boolean := True;
pragma Unmodified (A); -- Valid
pragma Unreferenced (B); -- Valid
pragma Unmodified (C); -- Valid
pragma Unreferenced (C); -- Valid
pragma Unused (D); -- Valid
begin
X := True; -- Warn Unmodified
Z := X; -- Warn Unreferenced
Y := True; -- Warn Unused
Z := Y; -- Warn Unused
Z := A; -- Valid
B := False; -- Valid
end Main;
----------------------------
-- Compilation and output --
----------------------------
$ gcc -gnatl -c main.adb
[...]
1. with Ada.Text_IO;
2.
3. -- Context clause
4. pragma Unused (Ada.Text_IO); -- Warn Unused
|
>>> pragma "Unused" argument must be in same declarative part
5. pragma Unmodified (Ada.Text_IO); -- Warn Unmodified
|
>>> pragma "Unmodified" argument must be in same declarative part
6. pragma Unreferenced (Ada.Text_IO); -- Valid
7.
8. procedure Main is
9.
10. -- Improper use
11. X, Y, Z : Boolean := False;
12.
13. -- Non-variable
14. procedure Test is begin null; end;
15. pragma Unmodified (Test); -- Warn Unmodified
|
>>> pragma "Unmodified" can only be applied to a variable
16. pragma Unused (Test); -- Warn Unused
|
>>> pragma "Unused" can only be applied to a variable
17. pragma Unreferenced (Test); -- Valid
18.
19. -- Equivalence of Unused to Unmodified + Unreferenced
20. pragma Unmodified (X); -- Valid
21. pragma Unmodified (X); -- Warn Unmodified
|
>>> warning: pragma Unmodified given for "X"
22. pragma Unreferenced (X); -- Valid
23. pragma Unused (Y); -- Valid
24.
25. -- Duplicate error messages
26. pragma Unreferenced (X); -- Warn Unreferenced
|
>>> warning: pragma Unreferenced given for "X"
27. pragma Unused (X); -- Warn Unmodified and Unreferenced
|
>>> warning: pragma Unmodified given for "X"
>>> warning: pragma Unreferenced given for "X"
28. pragma Unused (Y); -- Warn Unused
|
>>> warning: pragma Unused given for "Y"
29. pragma Unmodified (Y); -- Warn Unused
|
>>> warning: pragma Unused given for "Y"
30. pragma Unreferenced (Y); -- Warn Unused
|
>>> warning: pragma Unused given for "Y"
31.
32. -- Proper use
33. A, B, C, D : Boolean := True;
34. pragma Unmodified (A); -- Valid
35. pragma Unreferenced (B); -- Valid
36. pragma Unmodified (C); -- Valid
37. pragma Unreferenced (C); -- Valid
38. pragma Unused (D); -- Valid
39.
40. begin
41. X := True; -- Warn Unmodified
|
>>> warning: pragma Unmodified given for "X"
42. Z := X; -- Warn Unreferenced
|
>>> warning: pragma Unreferenced given for "X"
43. Y := True; -- Warn Unused
|
>>> warning: pragma Unused given for "Y"
44. Z := Y; -- Warn Unused
|
>>> warning: pragma Unused given for "Y"
45. Z := A; -- Valid
46. B := False; -- Valid
47. end Main;
47 lines: 4 errors, 11 warnings
Tested on x86_64-pc-linux-gnu, committed on trunk
2016-07-04 Justin Squirek <squi...@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.
Index: einfo.adb
===================================================================
--- einfo.adb (revision 237957)
+++ einfo.adb (working copy)
@@ -608,8 +608,8 @@
-- 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 @@
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 @@
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 @@
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));
Index: einfo.ads
===================================================================
--- einfo.ads (revision 237957)
+++ einfo.ads (working copy)
@@ -1902,13 +1902,20 @@
-- 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
-- Predicate aspect applies to the type or subtype, or if it inherits a
@@ -5397,6 +5404,7 @@
-- 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 @@
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 @@
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 @@
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);
Index: sem_prag.adb
===================================================================
--- sem_prag.adb (revision 237960)
+++ sem_prag.adb (working copy)
@@ -3502,6 +3502,16 @@
-- 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 @@
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 @@
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 --
------------------------
@@ -22281,10 +22583,9 @@
-- body, not in the spec).
when Pragma_Unimplemented_Unit => Unimplemented_Unit : declare
- Cunitent : constant Entity_Id :=
+ 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,93 +22651,9 @@
-- pragma Unmodified (LOCAL_NAME {, LOCAL_NAME});
- when Pragma_Unmodified => Unmodified : declare
- Arg : Node_Id;
- Arg_Expr : Node_Id;
- Arg_Id : Entity_Id;
+ when Pragma_Unmodified =>
+ Analyze_Unmodified_Or_Unused;
- 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;
-
------------------
-- Unreferenced --
------------------
@@ -22447,134 +22664,9 @@
-- 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;
+ when Pragma_Unreferenced =>
+ Analyze_Unreferenced_Or_Unused;
- 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;
-
--------------------------
-- Unreferenced_Objects --
--------------------------
@@ -22681,30 +22773,16 @@
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);
+ when Pragma_Unused =>
+ Analyze_Unmodified_Or_Unused (Is_Unused => True);
+ Analyze_Unreferenced_Or_Unused (Is_Unused => True);
- -- 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));
-
-------------------
-- Use_VADS_Size --
-------------------
@@ -26386,8 +26464,8 @@
then
Error_Msg_N
("cannot modify inherited condition (SPARK RM 6.1.1(1))",
- Parent (Subp));
- Error_Msg_Sloc := Sloc (New_E);
+ Parent (Subp));
+ Error_Msg_Sloc := Sloc (New_E);
Error_Msg_Node_2 := Subp;
Error_Msg_NE
("\overriding of&# forces overriding of&",
@@ -28378,6 +28456,7 @@
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 @@
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,
Index: sem_util.adb
===================================================================
--- sem_util.adb (revision 237957)
+++ sem_util.adb (working copy)
@@ -17618,11 +17618,20 @@
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);
Index: par-prag.adb
===================================================================
--- par-prag.adb (revision 237957)
+++ par-prag.adb (working copy)
@@ -1487,6 +1487,7 @@
Pragma_Unreferenced_Objects |
Pragma_Unreserve_All_Interrupts |
Pragma_Unsuppress |
+ Pragma_Unused |
Pragma_Use_VADS_Size |
Pragma_Volatile |
Pragma_Volatile_Components |
Index: snames.ads-tmpl
===================================================================
--- snames.ads-tmpl (revision 237957)
+++ snames.ads-tmpl (working copy)
@@ -653,6 +653,7 @@
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 @@
Pragma_Unreferenced,
Pragma_Unreferenced_Objects,
Pragma_Unreserve_All_Interrupts,
+ Pragma_Unused,
Pragma_Volatile,
Pragma_Volatile_Components,
Pragma_Volatile_Full_Access,
Index: lib-xref.adb
===================================================================
--- lib-xref.adb (revision 237957)
+++ lib-xref.adb (working copy)
@@ -841,6 +841,8 @@
-- 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 @@
BE := First_Entity (Current_Scope);
while Present (BE) loop
if Chars (BE) = Chars (E) then
- Error_Msg_NE -- CODEFIX
- ("??pragma Unreferenced given for&!", N, BE);
+ 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 @@
-- 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);
