From 9d1d00ca249c62a6df038254e1fc986bd6b26f39 Mon Sep 17 00:00:00 2001 From: Justin Squirek Date: Mon, 4 Jul 2016 10:05:53 +0000 Subject: [PATCH] einfo.adb (Has_Pragma_Unused): Create this function as a setter for a new flag294 (Set_Has_Pragma_Unused):... 2016-07-04 Justin Squirek * 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 --- gcc/ada/ChangeLog | 26 ++ gcc/ada/einfo.adb | 13 +- gcc/ada/einfo.ads | 21 +- gcc/ada/lib-xref.adb | 14 +- gcc/ada/par-prag.adb | 1 + gcc/ada/sem_prag.adb | 559 +++++++++++++++++++++++----------------- gcc/ada/sem_util.adb | 13 +- gcc/ada/snames.ads-tmpl | 2 + 8 files changed, 399 insertions(+), 250 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 6784eb24502..bbd98c4229a 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,29 @@ +2016-07-04 Justin Squirek + + * 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 * freeze.adb (Check_Inherited_Conditions): Perform two passes over diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index fd01315215e..ae4a3bb2c6e 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -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)); diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 683c281e24f..3a2d382f763 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -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); diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb index bff6d25b7c8..b1d5978549e 100644 --- a/gcc/ada/lib-xref.adb +++ b/gcc/ada/lib-xref.adb @@ -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 - 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 @@ 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); diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb index 56299140d4d..900d96a866f 100644 --- a/gcc/ada/par-prag.adb +++ b/gcc/ada/par-prag.adb @@ -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 | diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 90d00fca9a1..999ae352de4 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -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 -- ------------------------ @@ -22281,10 +22583,9 @@ package body Sem_Prag is -- 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,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 -- - ---------------------------- - - -- 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; + ------------ + -- Unused -- + ------------ - -- Store proper setting of Uneval_Old + -- pragma Unused (LOCAL_NAME {, LOCAL_NAME}); - 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 -- @@ -26386,8 +26464,8 @@ package body Sem_Prag is 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 @@ 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, diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 0c4f9ebe46a..94e97b4e28a 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -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); diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index 76b353bad7b..920b24ef12e 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -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, -- 2.30.2