diff options
| author | Justin Squirek <squirek@adacore.com> | 2021-12-09 17:06:20 +0000 |
|---|---|---|
| committer | Pierre-Marie de Rodat <derodat@adacore.com> | 2022-01-07 16:24:13 +0000 |
| commit | 72a29376c63172540576bd9b1d20f5c7c0e42cf3 (patch) | |
| tree | d89ba0df82e77fdccc8d5236f819bda97624049c /gcc/ada | |
| parent | e2b07ba054daa896795e0932626f259c87417ec0 (diff) | |
| download | gcc-72a29376c63172540576bd9b1d20f5c7c0e42cf3.zip gcc-72a29376c63172540576bd9b1d20f5c7c0e42cf3.tar.gz gcc-72a29376c63172540576bd9b1d20f5c7c0e42cf3.tar.bz2 | |
[Ada] Cleanup and modification of unreferenced warnings
gcc/ada/
* comperr.adb (Delete_SCIL_Files): Replace unnecessary
Unreferenced pragma with specific pragma Warnings.
* doc/gnat_rm/implementation_defined_pragmas.rst (Unreferenced):
Add documentation for new behavior.
* gnat_rm.texi: Regenerate.
* erroutc.adb (Set_At): Remove useless assignment.
* exp_ch2.adb (In_Assignment_Context): Deleted.
(Is_Object_Renaming_Name): Replace calls to Is_LHS with calls to
Known_To_Be_Assigned.
(Expand_Current_Value): Replace calls to May_Be_Lvalue with
calls to Known_To_Be_Assigned.
(Expand_Entry_Paramter): Replace calls to In_Assignment_Context
with calls to Known_To_Be_Assigned.
* exp_ch4.adb (Expand_N_Op_Rem): Remove unnecessary Unreferenced
pragma.
* exp_imgv.adb (Build_Enumeration_Image_Tables): Default
initialize S_N.
* ghost.adb (Check_Ghost_Policy): Replace call to May_Be_Lvalue
with call to Known_To_Be_Assigned.
* lib-xref.adb (Is_On_LHS): Deleted.
(OK_To_Set_Referenced): Rewrite subprogram to encompass the new
pragma Unreferenced behavior.
(Process_Deferred_References): Replace call to Is_LHS with call
to Known_To_Be_Assigned.
* libgnarl/s-taasde.adb, libgnarl/s-tasren.adb,
libgnarl/s-tpobop.adb, libgnat/a-calend.adb,
libgnat/a-calfor.adb, libgnat/a-cbdlli.adb,
libgnat/a-cbhama.adb, libgnat/a-cbhase.adb,
libgnat/a-cbmutr.adb, libgnat/a-cborma.adb,
libgnat/a-cborse.adb, libgnat/a-cdlili.adb,
libgnat/a-cfhama.adb, libgnat/a-cforse.adb,
libgnat/a-cidlli.adb, libgnat/a-cihama.adb,
libgnat/a-cihase.adb, libgnat/a-cimutr.adb,
libgnat/a-ciorma.adb, libgnat/a-ciormu.adb,
libgnat/a-ciorse.adb, libgnat/a-cohama.adb,
libgnat/a-cohase.adb, libgnat/a-comutr.adb,
libgnat/a-convec.adb, libgnat/a-coorma.adb,
libgnat/a-coormu.adb, libgnat/a-coorse.adb,
libgnat/a-crdlli.adb, libgnat/a-tigeau.adb,
libgnat/a-wtgeau.adb, libgnat/a-ztgeau.adb,
libgnat/g-calend.adb, libgnat/g-comlin.adb,
libgnat/g-expect.adb, libgnat/g-mbflra.adb,
libgnat/g-spipat.adb, libgnat/s-fatgen.adb,
libgnat/s-fileio.adb, libgnat/s-os_lib.adb,
libgnat/s-regpat.adb, libgnat/s-valued.adb,
libgnat/s-valuer.adb: Remove unnecessary Unreferenced pragmas
* sem_ch10.adb (Process_Spec_Clauses): Remove useless
assignments.
* sem_ch13.adb (Validate_Literal_Aspect): Default initialize I.
* sem_ch3.adb (Build_Derived_Concurrent_Type): Default
initialize Corr_Decl.
* sem_ch8.adb (Undefined): Replace calls to Is_LHS with calls to
Known_To_Be_Assigned.
(In_Abstract_View_Pragma): Likewise.
* sem_eval.adb (Eval_Selected_Component): Replace calls to
Is_LHS with calls to Known_To_Be_Assigned.
* sem_res.adb (Init_Component): Replace calls to May_Be_Lvalue
with calls to Known_To_Be_Assigned.
* sem_util.adb, sem_util.ads (End_Label_Loc): Default initialize
Owner.
(Explain_Limited_Type): Default initialize Expr_Func.
(Find_Actual): Modified to handle entry families.
(Is_LHS): Deleted.
(May_Be_Lvalue): Deleted.
(Known_To_Be_Assigned): Modified and improved to handle all
cases.
* sem_warn.adb (Traverse_Result): Replace calls to May_Be_Lvalue
with calls to Known_To_Be_Assigned.
(Check_Ref): Modify error on unreferenced out parameters to take
into account different warning flags.
Diffstat (limited to 'gcc/ada')
61 files changed, 255 insertions, 753 deletions
diff --git a/gcc/ada/comperr.adb b/gcc/ada/comperr.adb index e009c58..be40288 100644 --- a/gcc/ada/comperr.adb +++ b/gcc/ada/comperr.adb @@ -424,7 +424,7 @@ package body Comperr is Unit_Name : Node_Id; Success : Boolean; - pragma Unreferenced (Success); + pragma Warnings (Off, "modified by call"); procedure Decode_Name_Buffer; -- Replace "__" by "." in Name_Buffer, and adjust Name_Len accordingly diff --git a/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst b/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst index ca36a10..fbd60eb 100644 --- a/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst +++ b/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst @@ -7137,7 +7137,9 @@ or not to be given individually for each accept statement. The left hand side of an assignment does not count as a reference for the purpose of this pragma. Thus it is fine to assign to an entity for which -pragma Unreferenced is given. +pragma Unreferenced is given. However, use of an entity as an actual for +an out parameter does count as a reference unless warnings for unread output +parameters are enabled via :switch:`-gnatw.o`. Note that if a warning is desired for all calls to a given subprogram, regardless of whether they occur in the same unit as the subprogram diff --git a/gcc/ada/erroutc.adb b/gcc/ada/erroutc.adb index 8225fd4..bdb0b13 100644 --- a/gcc/ada/erroutc.adb +++ b/gcc/ada/erroutc.adb @@ -1226,7 +1226,6 @@ package body Erroutc is else Set_At; Set_Msg_Str ("line "); - Int_File := False; Set_Msg_Int (Int (Get_Logical_Line_Number (Loc))); end if; diff --git a/gcc/ada/exp_ch2.adb b/gcc/ada/exp_ch2.adb index a8b20aa..e687736 100644 --- a/gcc/ada/exp_ch2.adb +++ b/gcc/ada/exp_ch2.adb @@ -144,7 +144,7 @@ package body Exp_Ch2 is -- Do not replace lvalues - and then not May_Be_Lvalue (N) + and then not Known_To_Be_Assigned (N) -- Check that entity is suitable for replacement @@ -423,7 +423,7 @@ package body Exp_Ch2 is and then Is_Scalar_Type (Etype (N)) and then (Is_Assignable (E) or else Is_Constant_Object (E)) and then Comes_From_Source (N) - and then Is_LHS (N) = No + and then not Known_To_Be_Assigned (N) and then not Is_Actual_Out_Parameter (N) and then (Nkind (Parent (N)) /= N_Attribute_Reference or else Attribute_Name (Parent (N)) /= Name_Valid) @@ -541,51 +541,6 @@ package body Exp_Ch2 is Addr_Ent : constant Entity_Id := Node (Last_Elmt (Acc_Stack)); P_Comp_Ref : Entity_Id; - function In_Assignment_Context (N : Node_Id) return Boolean; - -- Check whether this is a context in which the entry formal may be - -- assigned to. - - --------------------------- - -- In_Assignment_Context -- - --------------------------- - - function In_Assignment_Context (N : Node_Id) return Boolean is - begin - -- Case of use in a call - - -- ??? passing a formal as actual for a mode IN formal is - -- considered as an assignment? - - if Nkind (Parent (N)) in - N_Procedure_Call_Statement | N_Entry_Call_Statement - or else (Nkind (Parent (N)) = N_Assignment_Statement - and then N = Name (Parent (N))) - then - return True; - - -- Case of a parameter association: climb up to enclosing call - - elsif Nkind (Parent (N)) = N_Parameter_Association then - return In_Assignment_Context (Parent (N)); - - -- Case of a selected component, indexed component or slice prefix: - -- climb up the tree, unless the prefix is of an access type (in - -- which case there is an implicit dereference, and the formal itself - -- is not being assigned to). - - elsif Nkind (Parent (N)) in - N_Selected_Component | N_Indexed_Component | N_Slice - and then N = Prefix (Parent (N)) - and then not Is_Access_Type (Etype (N)) - and then In_Assignment_Context (Parent (N)) - then - return True; - - else - return False; - end if; - end In_Assignment_Context; - -- Start of processing for Expand_Entry_Parameter begin @@ -604,7 +559,7 @@ package body Exp_Ch2 is -- done during semantic processing so it is called in -gnatc mode??? if Ekind (Entity (N)) /= E_In_Parameter - and then In_Assignment_Context (N) + and then Known_To_Be_Assigned (N) then Note_Possible_Modification (N, Sure => True); end if; diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 262e40e..5347238 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -10413,8 +10413,6 @@ package body Exp_Ch4 is Rneg : Boolean; -- Set if corresponding operand can be negative - pragma Unreferenced (Hi); - begin Binary_Op_Validity_Checks (N); diff --git a/gcc/ada/exp_imgv.adb b/gcc/ada/exp_imgv.adb index f2c5129..64b11fb 100644 --- a/gcc/ada/exp_imgv.adb +++ b/gcc/ada/exp_imgv.adb @@ -90,7 +90,7 @@ package body Exp_Imgv is Lit : Entity_Id; Nlit : Nat; S_Id : Entity_Id; - S_N : Nat; + S_N : Nat := 0; Str : String_Id; package SPHG renames System.Perfect_Hash_Generators; diff --git a/gcc/ada/ghost.adb b/gcc/ada/ghost.adb index 1720fe0..c7d4741 100644 --- a/gcc/ada/ghost.adb +++ b/gcc/ada/ghost.adb @@ -530,7 +530,7 @@ package body Ghost is if Is_Checked_Ghost_Entity (Id) and then Policy = Name_Ignore - and then May_Be_Lvalue (Ref) + and then Known_To_Be_Assigned (Ref) then Error_Msg_Sloc := Sloc (Ref); diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 32d1a89..687e2e4 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -8662,7 +8662,9 @@ or not to be given individually for each accept statement. The left hand side of an assignment does not count as a reference for the purpose of this pragma. Thus it is fine to assign to an entity for which -pragma Unreferenced is given. +pragma Unreferenced is given. However, use of an entity as an actual for +an out parameter does count as a reference unless warnings for unread output +parameters are enabled via @code{-gnatw.o}. Note that if a warning is desired for all calls to a given subprogram, regardless of whether they occur in the same unit as the subprogram diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb index 2c3c372..93ea4bb 100644 --- a/gcc/ada/lib-xref.adb +++ b/gcc/ada/lib-xref.adb @@ -415,22 +415,6 @@ package body Lib.Xref is -- Get the enclosing entity through renamings, which may come from -- source or from the translation of generic instantiations. - function Is_On_LHS (Node : Node_Id) return Boolean; - -- Used to check if a node is on the left hand side of an assignment. - -- The following cases are handled: - -- - -- Variable Node is a direct descendant of left hand side of an - -- assignment statement. - -- - -- Prefix Of an indexed or selected component that is present in - -- a subtree rooted by an assignment statement. There is - -- no restriction of nesting of components, thus cases - -- such as A.B (C).D are handled properly. However a prefix - -- of a dereference (either implicit or explicit) is never - -- considered as on a LHS. - -- - -- Out param Same as above cases, but OUT parameter - function OK_To_Set_Referenced return Boolean; -- Returns True if the Referenced flag can be set. There are a few -- exceptions where we do not want to set this flag, see body for @@ -499,85 +483,6 @@ package body Lib.Xref is end case; end Get_Through_Renamings; - --------------- - -- Is_On_LHS -- - --------------- - - -- ??? There are several routines here and there that perform a similar - -- (but subtly different) computation, which should be factored: - - -- Sem_Util.Is_LHS - -- Sem_Util.May_Be_Lvalue - -- Sem_Util.Known_To_Be_Assigned - -- Exp_Ch2.Expand_Entry_Parameter.In_Assignment_Context - -- Exp_Smem.Is_Out_Actual - - function Is_On_LHS (Node : Node_Id) return Boolean is - N : Node_Id; - P : Node_Id; - K : Node_Kind; - - begin - -- Only identifiers are considered, is this necessary??? - - if Nkind (Node) /= N_Identifier then - return False; - end if; - - -- Immediate return if appeared as OUT parameter - - if Kind = E_Out_Parameter then - return True; - end if; - - -- Search for assignment statement subtree root - - N := Node; - loop - P := Parent (N); - K := Nkind (P); - - if K = N_Assignment_Statement then - return Name (P) = N; - - -- Check whether the parent is a component and the current node is - -- its prefix, but return False if the current node has an access - -- type, as in that case the selected or indexed component is an - -- implicit dereference, and the LHS is the designated object, not - -- the access object. - - -- ??? case of a slice assignment? - - elsif (K = N_Selected_Component or else K = N_Indexed_Component) - and then Prefix (P) = N - then - -- Check for access type. First a special test, In some cases - -- this is called too early (see comments in Find_Direct_Name), - -- at a point where the tree is not fully typed yet. In that - -- case we may lack an Etype for N, and we can't check the - -- Etype. For now, we always return False in such a case, - -- but this is clearly not right in all cases ??? - - if No (Etype (N)) then - return False; - - elsif Is_Access_Type (Etype (N)) then - return False; - - -- Access type case dealt with, keep going - - else - N := P; - end if; - - -- All other cases, definitely not on left side - - else - return False; - end if; - end loop; - end Is_On_LHS; - --------------------------- -- OK_To_Set_Referenced -- --------------------------- @@ -822,46 +727,32 @@ package body Lib.Xref is if Set_Ref then - -- Assignable object appearing on left side of assignment or as - -- an out parameter. + -- When E itself is an IN OUT parameter mark it referenced if Is_Assignable (E) - and then Is_On_LHS (N) - and then Ekind (E) /= E_In_Out_Parameter + and then Ekind (E) = E_In_Out_Parameter + and then Known_To_Be_Assigned (N) then - -- For objects that are renamings, just set as simply referenced - -- we do not try to do assignment type tracking in this case. - - if Present (Renamed_Object (E)) then - Set_Referenced (E); - - -- Out parameter case - - elsif Kind = E_Out_Parameter then - - -- If warning mode for all out parameters is set, or this is - -- the only warning parameter, then we want to mark this for - -- later warning logic by setting Referenced_As_Out_Parameter + Set_Referenced (E); - if Warn_On_Modified_As_Out_Parameter (Formal) then - Set_Referenced_As_Out_Parameter (E, True); - Set_Referenced_As_LHS (E, False); + -- For the case where the entity is on the left hand side of an + -- assignment statment, we do nothing here. - -- For OUT parameter not covered by the above cases, we simply - -- regard it as a normal reference (in this case we do not - -- want any of the warning machinery for out parameters). + -- The processing for Analyze_Assignment_Statement will set the + -- Referenced_As_LHS flag. - else - Set_Referenced (E); - end if; + elsif Is_Assignable (E) + and then Known_To_Be_Assigned (N, Only_LHS => True) + then + null; - -- For the left hand of an assignment case, we do nothing here. - -- The processing for Analyze_Assignment will set the - -- Referenced_As_LHS flag. + -- For objects that are renamings, just set as simply referenced. + -- We do not try to do assignment type tracking in this case. - else - null; - end if; + elsif Is_Assignable (E) + and then Present (Renamed_Object (E)) + then + Set_Referenced (E); -- Check for a reference in a pragma that should not count as a -- making the variable referenced for warning purposes. @@ -901,58 +792,75 @@ package body Lib.Xref is then null; - -- All other cases + -- Out parameter case - else - -- Special processing for IN OUT parameters, where we have an - -- implicit assignment to a simple variable. + elsif Kind = E_Out_Parameter + and then Is_Assignable (E) + then + -- If warning mode for all out parameters is set, or this is + -- the only warning parameter, then we want to mark this for + -- later warning logic by setting Referenced_As_Out_Parameter - if Kind = E_In_Out_Parameter - and then Is_Assignable (E) - then - -- For sure this counts as a normal read reference + if Warn_On_Modified_As_Out_Parameter (Formal) then + Set_Referenced_As_Out_Parameter (E, True); + Set_Referenced_As_LHS (E, False); + + -- For OUT parameter not covered by the above cases, we simply + -- regard it as a non-reference. + else + Set_Referenced_As_Out_Parameter (E); Set_Referenced (E); - Set_Last_Assignment (E, Empty); + end if; - -- We count it as being referenced as an out parameter if the - -- option is set to warn on all out parameters, except that we - -- have a special exclusion for an intrinsic subprogram, which - -- is most likely an instantiation of Unchecked_Deallocation - -- which we do not want to consider as an assignment since it - -- generates false positives. We also exclude the case of an - -- IN OUT parameter if the name of the procedure is Free, - -- since we suspect similar semantics. - - if Warn_On_All_Unread_Out_Parameters - and then Is_Entity_Name (Name (Call)) - and then not Is_Intrinsic_Subprogram (Entity (Name (Call))) - and then Chars (Name (Call)) /= Name_Free - then - Set_Referenced_As_Out_Parameter (E, True); - Set_Referenced_As_LHS (E, False); - end if; + -- Special processing for IN OUT parameters, where we have an + -- implicit assignment to a simple variable. - -- Don't count a recursive reference within a subprogram as a - -- reference (that allows detection of a recursive subprogram - -- whose only references are recursive calls as unreferenced). + elsif Kind = E_In_Out_Parameter + and then Is_Assignable (E) + then + -- For sure this counts as a normal read reference - elsif Is_Subprogram (E) - and then E = Nearest_Dynamic_Scope (Current_Scope) + Set_Referenced (E); + Set_Last_Assignment (E, Empty); + + -- We count it as being referenced as an out parameter if the + -- option is set to warn on all out parameters, except that we + -- have a special exclusion for an intrinsic subprogram, which + -- is most likely an instantiation of Unchecked_Deallocation + -- which we do not want to consider as an assignment since it + -- generates false positives. We also exclude the case of an + -- IN OUT parameter if the name of the procedure is Free, + -- since we suspect similar semantics. + + if Warn_On_All_Unread_Out_Parameters + and then Is_Entity_Name (Name (Call)) + and then not Is_Intrinsic_Subprogram (Entity (Name (Call))) + and then Chars (Name (Call)) /= Name_Free then - null; + Set_Referenced_As_Out_Parameter (E, True); + Set_Referenced_As_LHS (E, False); + end if; - -- Any other occurrence counts as referencing the entity + -- Don't count a recursive reference within a subprogram as a + -- reference (that allows detection of a recursive subprogram + -- whose only references are recursive calls as unreferenced). - elsif OK_To_Set_Referenced then - Set_Referenced (E); + elsif Is_Subprogram (E) + and then E = Nearest_Dynamic_Scope (Current_Scope) + then + null; - -- If variable, this is an OK reference after an assignment - -- so we can clear the Last_Assignment indication. + -- Any other occurrence counts as referencing the entity - if Is_Assignable (E) then - Set_Last_Assignment (E, Empty); - end if; + elsif OK_To_Set_Referenced then + Set_Referenced (E); + + -- If variable, this is an OK reference after an assignment + -- so we can clear the Last_Assignment indication. + + if Is_Assignable (E) then + Set_Last_Assignment (E, Empty); end if; end if; @@ -965,7 +873,7 @@ package body Lib.Xref is and then In_Same_Extended_Unit (E, N) then -- A reference as a named parameter in a call does not count as a - -- violation of pragma Unreferenced for this purpose... + -- violation of pragma Unreferenced for this purpose. if Nkind (N) = N_Identifier and then Nkind (Parent (N)) = N_Parameter_Association @@ -973,10 +881,24 @@ package body Lib.Xref is then null; - -- ... Neither does a reference to a variable on the left side of - -- an assignment. - - elsif Is_On_LHS (N) then + -- Neither does a reference to a variable on the left side of + -- an assignment or use of an out parameter with warnings for + -- unread out parameters specified (via -gnatw.o). + + -- The reason for treating unread out parameters in a special + -- way is so that when pragma Unreferenced is specified on such + -- an out parameter we do not want to issue a warning about the + -- pragma being unnecessary - because the purpose of the flag + -- is to warn about them not being read (e.g. unreferenced) + -- after use. + + elsif (Known_To_Be_Assigned (N, Only_LHS => True) + or else (Present (Formal) + and then Ekind (Formal) = E_Out_Parameter + and then Warn_On_All_Unread_Out_Parameters)) + and then not (Ekind (E) = E_In_Out_Parameter + and then Known_To_Be_Assigned (N)) + then null; -- Do not consider F'Result as a violation of pragma Unreferenced @@ -2841,18 +2763,13 @@ package body Lib.Xref is D : Deferred_Reference_Entry renames Deferred_References.Table (J); begin - case Is_LHS (D.N) is - when Yes => + case Known_To_Be_Assigned (D.N) is + when True => Generate_Reference (D.E, D.N, 'm'); - when No => + when False => Generate_Reference (D.E, D.N, 'r'); - -- Not clear if Unknown can occur at this stage, but if it - -- does we will treat it as a normal reference. - - when Unknown => - Generate_Reference (D.E, D.N, 'r'); end case; end; end loop; diff --git a/gcc/ada/libgnarl/s-taasde.adb b/gcc/ada/libgnarl/s-taasde.adb index 67cd4a9..cf04b06 100644 --- a/gcc/ada/libgnarl/s-taasde.adb +++ b/gcc/ada/libgnarl/s-taasde.adb @@ -264,8 +264,6 @@ package body System.Tasking.Async_Delays is Dequeued : Delay_Block_Access; Dequeued_Task : Task_Id; - pragma Unreferenced (Timedout, Yielded); - begin pragma Assert (Timer_Server_ID = STPO.Self); diff --git a/gcc/ada/libgnarl/s-tasren.adb b/gcc/ada/libgnarl/s-tasren.adb index 7b11d39..3a3739a 100644 --- a/gcc/ada/libgnarl/s-tasren.adb +++ b/gcc/ada/libgnarl/s-tasren.adb @@ -305,7 +305,6 @@ package body System.Tasking.Rendezvous is Uninterpreted_Data : System.Address) is Rendezvous_Successful : Boolean; - pragma Unreferenced (Rendezvous_Successful); begin -- If pragma Detect_Blocking is active then Program_Error must be @@ -1438,7 +1437,6 @@ package body System.Tasking.Rendezvous is Entry_Call : Entry_Call_Link; Yielded : Boolean; - pragma Unreferenced (Yielded); begin -- If pragma Detect_Blocking is active then Program_Error must be diff --git a/gcc/ada/libgnarl/s-tpobop.adb b/gcc/ada/libgnarl/s-tpobop.adb index 90e45e9..7be4c9f 100644 --- a/gcc/ada/libgnarl/s-tpobop.adb +++ b/gcc/ada/libgnarl/s-tpobop.adb @@ -857,7 +857,6 @@ package body System.Tasking.Protected_Objects.Operations is Ceiling_Violation : Boolean; Yielded : Boolean; - pragma Unreferenced (Yielded); begin if Self_Id.ATC_Nesting_Level = ATC_Level'Last then diff --git a/gcc/ada/libgnat/a-calend.adb b/gcc/ada/libgnat/a-calend.adb index 3d7ae90..f7d8395 100644 --- a/gcc/ada/libgnat/a-calend.adb +++ b/gcc/ada/libgnat/a-calend.adb @@ -490,7 +490,6 @@ is Y : Year_Number; M : Month_Number; S : Day_Duration; - pragma Unreferenced (Y, M, S); begin Split (Date, Y, M, D, S); return D; @@ -537,7 +536,6 @@ is M : Month_Number; D : Day_Number; S : Day_Duration; - pragma Unreferenced (Y, D, S); begin Split (Date, Y, M, D, S); return M; @@ -552,7 +550,6 @@ is M : Month_Number; D : Day_Number; S : Day_Duration; - pragma Unreferenced (Y, M, D); begin Split (Date, Y, M, D, S); return S; @@ -575,8 +572,6 @@ is Ss : Duration; Le : Boolean; - pragma Unreferenced (H, M, Se, Ss, Le); - begin -- Even though the input time zone is UTC (0), the flag Use_TZ will -- ensure that Split picks up the local time zone. @@ -769,7 +764,6 @@ is M : Month_Number; D : Day_Number; S : Day_Duration; - pragma Unreferenced (M, D, S); begin Split (Date, Y, M, D, S); return Y; diff --git a/gcc/ada/libgnat/a-calfor.adb b/gcc/ada/libgnat/a-calfor.adb index 2f2b374..82b6ef4 100644 --- a/gcc/ada/libgnat/a-calfor.adb +++ b/gcc/ada/libgnat/a-calfor.adb @@ -99,8 +99,6 @@ package body Ada.Calendar.Formatting is Ss : Second_Duration; Le : Boolean; - pragma Unreferenced (Y, Mo, H, Mi); - begin Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le, Time_Zone); return D; @@ -132,8 +130,6 @@ package body Ada.Calendar.Formatting is Ss : Second_Duration; Le : Boolean; - pragma Unreferenced (Y, Mo, D, Mi); - begin Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le, Time_Zone); return H; @@ -290,8 +286,6 @@ package body Ada.Calendar.Formatting is Ss : Second_Duration; Le : Boolean; - pragma Unreferenced (Y, Mo, D, H); - begin Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le, Time_Zone); return Mi; @@ -314,8 +308,6 @@ package body Ada.Calendar.Formatting is Ss : Second_Duration; Le : Boolean; - pragma Unreferenced (Y, D, H, Mi); - begin Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le, Time_Zone); return Mo; @@ -335,8 +327,6 @@ package body Ada.Calendar.Formatting is Ss : Second_Duration; Le : Boolean; - pragma Unreferenced (Y, Mo, D, H, Mi); - begin Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le); return Se; @@ -583,8 +573,6 @@ package body Ada.Calendar.Formatting is Ss : Second_Duration; Le : Boolean; - pragma Unreferenced (Y, Mo, D, H, Mi); - begin Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le); return Ss; @@ -897,8 +885,6 @@ package body Ada.Calendar.Formatting is Ss : Second_Duration; Le : Boolean; - pragma Unreferenced (Mo, D, H, Mi); - begin Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le, Time_Zone); return Y; diff --git a/gcc/ada/libgnat/a-cbdlli.adb b/gcc/ada/libgnat/a-cbdlli.adb index 3752ca9..4939b4d 100644 --- a/gcc/ada/libgnat/a-cbdlli.adb +++ b/gcc/ada/libgnat/a-cbdlli.adb @@ -995,7 +995,6 @@ is Count : Count_Type := 1) is Position : Cursor; - pragma Unreferenced (Position); begin Insert (Container, Before, New_Item, Position, Count); end Insert; diff --git a/gcc/ada/libgnat/a-cbhama.adb b/gcc/ada/libgnat/a-cbhama.adb index 26c01f5..c4a9cc2 100644 --- a/gcc/ada/libgnat/a-cbhama.adb +++ b/gcc/ada/libgnat/a-cbhama.adb @@ -697,8 +697,6 @@ is New_Item : Element_Type) is Position : Cursor; - pragma Unreferenced (Position); - Inserted : Boolean; begin diff --git a/gcc/ada/libgnat/a-cbhase.adb b/gcc/ada/libgnat/a-cbhase.adb index 0c20341..bc0a1ca 100644 --- a/gcc/ada/libgnat/a-cbhase.adb +++ b/gcc/ada/libgnat/a-cbhase.adb @@ -736,8 +736,6 @@ is New_Item : Element_Type) is Position : Cursor; - pragma Unreferenced (Position); - Inserted : Boolean; begin diff --git a/gcc/ada/libgnat/a-cbmutr.adb b/gcc/ada/libgnat/a-cbmutr.adb index e80eb5c..8b8ffc3 100644 --- a/gcc/ada/libgnat/a-cbmutr.adb +++ b/gcc/ada/libgnat/a-cbmutr.adb @@ -1490,7 +1490,6 @@ is Count : Count_Type := 1) is Position : Cursor; - pragma Unreferenced (Position); begin Insert_Child (Container, Parent, Before, New_Item, Position, Count); diff --git a/gcc/ada/libgnat/a-cborma.adb b/gcc/ada/libgnat/a-cborma.adb index f26a1e3..74e1d4d 100644 --- a/gcc/ada/libgnat/a-cborma.adb +++ b/gcc/ada/libgnat/a-cborma.adb @@ -824,8 +824,6 @@ is New_Item : Element_Type) is Position : Cursor; - pragma Unreferenced (Position); - Inserted : Boolean; begin diff --git a/gcc/ada/libgnat/a-cborse.adb b/gcc/ada/libgnat/a-cborse.adb index 0328b16..fd1e0fe 100644 --- a/gcc/ada/libgnat/a-cborse.adb +++ b/gcc/ada/libgnat/a-cborse.adb @@ -1099,8 +1099,6 @@ is New_Item : Element_Type) is Position : Cursor; - pragma Unreferenced (Position); - Inserted : Boolean; begin @@ -1180,7 +1178,6 @@ is Dst_Node : out Count_Type) is Success : Boolean; - pragma Unreferenced (Success); procedure Set_Element (Node : in out Node_Type); pragma Inline (Set_Element); @@ -1987,6 +1984,7 @@ is function To_Set (New_Item : Element_Type) return Set is Node : Count_Type; Inserted : Boolean; + begin return S : Set (1) do Insert_Sans_Hint (S, New_Item, Node, Inserted); diff --git a/gcc/ada/libgnat/a-cdlili.adb b/gcc/ada/libgnat/a-cdlili.adb index 1d48ed9..7d8dbed 100644 --- a/gcc/ada/libgnat/a-cdlili.adb +++ b/gcc/ada/libgnat/a-cdlili.adb @@ -810,7 +810,6 @@ is Count : Count_Type := 1) is Position : Cursor; - pragma Unreferenced (Position); begin Insert (Container, Before, New_Item, Position, Count); end Insert; diff --git a/gcc/ada/libgnat/a-cfhama.adb b/gcc/ada/libgnat/a-cfhama.adb index 179b400..b897b41 100644 --- a/gcc/ada/libgnat/a-cfhama.adb +++ b/gcc/ada/libgnat/a-cfhama.adb @@ -670,8 +670,6 @@ is New_Item : Element_Type) is Position : Cursor; - pragma Unreferenced (Position); - Inserted : Boolean; begin diff --git a/gcc/ada/libgnat/a-cforse.adb b/gcc/ada/libgnat/a-cforse.adb index 7c45e4f..df2b7af 100644 --- a/gcc/ada/libgnat/a-cforse.adb +++ b/gcc/ada/libgnat/a-cforse.adb @@ -1420,7 +1420,6 @@ is Dst_Node : out Count_Type) is Success : Boolean; - pragma Unreferenced (Success); procedure Set_Element (Node : in out Node_Type); @@ -1900,6 +1899,7 @@ is function To_Set (New_Item : Element_Type) return Set is Node : Count_Type; Inserted : Boolean; + begin return S : Set (Capacity => 1) do Insert_Sans_Hint (S.Content, New_Item, Node, Inserted); diff --git a/gcc/ada/libgnat/a-cidlli.adb b/gcc/ada/libgnat/a-cidlli.adb index 1cf9401..b55e5bb 100644 --- a/gcc/ada/libgnat/a-cidlli.adb +++ b/gcc/ada/libgnat/a-cidlli.adb @@ -902,7 +902,6 @@ is Count : Count_Type := 1) is Position : Cursor; - pragma Unreferenced (Position); begin Insert (Container, Before, New_Item, Position, Count); end Insert; diff --git a/gcc/ada/libgnat/a-cihama.adb b/gcc/ada/libgnat/a-cihama.adb index 2fbf65e..7217b5d 100644 --- a/gcc/ada/libgnat/a-cihama.adb +++ b/gcc/ada/libgnat/a-cihama.adb @@ -758,8 +758,6 @@ is New_Item : Element_Type) is Position : Cursor; - pragma Unreferenced (Position); - Inserted : Boolean; begin diff --git a/gcc/ada/libgnat/a-cihase.adb b/gcc/ada/libgnat/a-cihase.adb index 79a1fe6..804aa31 100644 --- a/gcc/ada/libgnat/a-cihase.adb +++ b/gcc/ada/libgnat/a-cihase.adb @@ -854,8 +854,6 @@ is New_Item : Element_Type) is Position : Cursor; - pragma Unreferenced (Position); - Inserted : Boolean; begin @@ -1728,7 +1726,6 @@ is HT : Hash_Table_Type; Node : Node_Access; Inserted : Boolean; - pragma Unreferenced (Node, Inserted); begin Insert (HT, New_Item, Node, Inserted); return Set'(Controlled with HT); @@ -1776,7 +1773,6 @@ is Tgt_Node : Node_Access; Success : Boolean; - pragma Unreferenced (Tgt_Node, Success); -- Start of processing for Process diff --git a/gcc/ada/libgnat/a-cimutr.adb b/gcc/ada/libgnat/a-cimutr.adb index aa7efac..a04db9c 100644 --- a/gcc/ada/libgnat/a-cimutr.adb +++ b/gcc/ada/libgnat/a-cimutr.adb @@ -1175,7 +1175,6 @@ is Count : Count_Type := 1) is Position : Cursor; - pragma Unreferenced (Position); begin Insert_Child (Container, Parent, Before, New_Item, Position, Count); diff --git a/gcc/ada/libgnat/a-ciorma.adb b/gcc/ada/libgnat/a-ciorma.adb index a569156..03da5eb 100644 --- a/gcc/ada/libgnat/a-ciorma.adb +++ b/gcc/ada/libgnat/a-ciorma.adb @@ -866,8 +866,6 @@ is New_Item : Element_Type) is Position : Cursor; - pragma Unreferenced (Position); - Inserted : Boolean; begin diff --git a/gcc/ada/libgnat/a-ciormu.adb b/gcc/ada/libgnat/a-ciormu.adb index f1b9021..3292637 100644 --- a/gcc/ada/libgnat/a-ciormu.adb +++ b/gcc/ada/libgnat/a-ciormu.adb @@ -1120,7 +1120,6 @@ is procedure Insert (Container : in out Set; New_Item : Element_Type) is Position : Cursor; - pragma Unreferenced (Position); begin Insert (Container, New_Item, Position); end Insert; @@ -1975,7 +1974,6 @@ is function To_Set (New_Item : Element_Type) return Set is Tree : Tree_Type; Node : Node_Access; - pragma Unreferenced (Node); begin Insert_Sans_Hint (Tree, New_Item, Node); return Set'(Controlled with Tree); diff --git a/gcc/ada/libgnat/a-ciorse.adb b/gcc/ada/libgnat/a-ciorse.adb index 4af4f89..4f129c5 100644 --- a/gcc/ada/libgnat/a-ciorse.adb +++ b/gcc/ada/libgnat/a-ciorse.adb @@ -1160,8 +1160,6 @@ is procedure Insert (Container : in out Set; New_Item : Element_Type) is Position : Cursor; - pragma Unreferenced (Position); - Inserted : Boolean; begin @@ -1239,7 +1237,6 @@ is Dst_Node : out Node_Access) is Success : Boolean; - pragma Unreferenced (Success); function New_Node return Node_Access; @@ -2120,7 +2117,6 @@ is Tree : Tree_Type; Node : Node_Access; Inserted : Boolean; - pragma Unreferenced (Node, Inserted); begin Insert_Sans_Hint (Tree, New_Item, Node, Inserted); return Set'(Controlled with Tree); diff --git a/gcc/ada/libgnat/a-cohama.adb b/gcc/ada/libgnat/a-cohama.adb index e6d6e4d..973b91d 100644 --- a/gcc/ada/libgnat/a-cohama.adb +++ b/gcc/ada/libgnat/a-cohama.adb @@ -698,8 +698,6 @@ is New_Item : Element_Type) is Position : Cursor; - pragma Unreferenced (Position); - Inserted : Boolean; begin diff --git a/gcc/ada/libgnat/a-cohase.adb b/gcc/ada/libgnat/a-cohase.adb index 6a4c121..3fe5b53 100644 --- a/gcc/ada/libgnat/a-cohase.adb +++ b/gcc/ada/libgnat/a-cohase.adb @@ -785,8 +785,6 @@ is New_Item : Element_Type) is Position : Cursor; - pragma Unreferenced (Position); - Inserted : Boolean; begin @@ -1562,7 +1560,6 @@ is Node : Node_Access; Inserted : Boolean; - pragma Unreferenced (Node, Inserted); begin Insert (HT, New_Item, Node, Inserted); @@ -1606,7 +1603,6 @@ is Tgt_Node : Node_Access; Success : Boolean; - pragma Unreferenced (Tgt_Node, Success); -- Start of processing for Process diff --git a/gcc/ada/libgnat/a-comutr.adb b/gcc/ada/libgnat/a-comutr.adb index 617d248..a592b8f 100644 --- a/gcc/ada/libgnat/a-comutr.adb +++ b/gcc/ada/libgnat/a-comutr.adb @@ -1130,7 +1130,6 @@ is Count : Count_Type := 1) is Position : Cursor; - pragma Unreferenced (Position); begin Insert_Child (Container, Parent, Before, New_Item, Position, Count); diff --git a/gcc/ada/libgnat/a-convec.adb b/gcc/ada/libgnat/a-convec.adb index 6f39ceb..e6d6a19 100644 --- a/gcc/ada/libgnat/a-convec.adb +++ b/gcc/ada/libgnat/a-convec.adb @@ -1264,6 +1264,7 @@ is declare SA : Elements_Array renames Container.Elements.EA; -- source DA : Elements_Array renames Dst.EA; -- destination + pragma Unreferenced (DA); begin DA (Index_Type'First .. Before - 1) := @@ -1918,6 +1919,7 @@ is declare SA : Elements_Array renames Container.Elements.EA; -- source DA : Elements_Array renames Dst.EA; -- destination + pragma Unreferenced (DA); begin DA (Index_Type'First .. Before - 1) := diff --git a/gcc/ada/libgnat/a-coorma.adb b/gcc/ada/libgnat/a-coorma.adb index 65adf4c..d575ddb 100644 --- a/gcc/ada/libgnat/a-coorma.adb +++ b/gcc/ada/libgnat/a-coorma.adb @@ -752,8 +752,6 @@ is New_Item : Element_Type) is Position : Cursor; - pragma Unreferenced (Position); - Inserted : Boolean; begin diff --git a/gcc/ada/libgnat/a-coormu.adb b/gcc/ada/libgnat/a-coormu.adb index 9b11d29..e34e908 100644 --- a/gcc/ada/libgnat/a-coormu.adb +++ b/gcc/ada/libgnat/a-coormu.adb @@ -1053,7 +1053,6 @@ is procedure Insert (Container : in out Set; New_Item : Element_Type) is Position : Cursor; - pragma Unreferenced (Position); begin Insert (Container, New_Item, Position); end Insert; @@ -1858,7 +1857,6 @@ is function To_Set (New_Item : Element_Type) return Set is Tree : Tree_Type; Node : Node_Access; - pragma Unreferenced (Node); begin Insert_Sans_Hint (Tree, New_Item, Node); return Set'(Controlled with Tree); diff --git a/gcc/ada/libgnat/a-coorse.adb b/gcc/ada/libgnat/a-coorse.adb index 0cb85c5..83f3885 100644 --- a/gcc/ada/libgnat/a-coorse.adb +++ b/gcc/ada/libgnat/a-coorse.adb @@ -1057,8 +1057,6 @@ is New_Item : Element_Type) is Position : Cursor; - pragma Unreferenced (Position); - Inserted : Boolean; begin @@ -1123,7 +1121,6 @@ is Dst_Node : out Node_Access) is Success : Boolean; - pragma Unreferenced (Success); function New_Node return Node_Access; pragma Inline (New_Node); @@ -1935,7 +1932,6 @@ is Tree : Tree_Type; Node : Node_Access; Inserted : Boolean; - pragma Unreferenced (Node, Inserted); begin Insert_Sans_Hint (Tree, New_Item, Node, Inserted); return Set'(Controlled with Tree); diff --git a/gcc/ada/libgnat/a-crdlli.adb b/gcc/ada/libgnat/a-crdlli.adb index 48cdb0c..c0ff2da 100644 --- a/gcc/ada/libgnat/a-crdlli.adb +++ b/gcc/ada/libgnat/a-crdlli.adb @@ -630,7 +630,6 @@ package body Ada.Containers.Restricted_Doubly_Linked_Lists is Count : Count_Type := 1) is Position : Cursor; - pragma Unreferenced (Position); begin Insert (Container, Before, New_Item, Position, Count); end Insert; diff --git a/gcc/ada/libgnat/a-tigeau.adb b/gcc/ada/libgnat/a-tigeau.adb index ef86ae0..263b602 100644 --- a/gcc/ada/libgnat/a-tigeau.adb +++ b/gcc/ada/libgnat/a-tigeau.adb @@ -317,7 +317,6 @@ package body Ada.Text_IO.Generic_Aux is Ptr : in out Integer) is Junk : Boolean; - pragma Unreferenced (Junk); begin Load_Extended_Digits (File, Buf, Ptr, Junk); end Load_Extended_Digits; diff --git a/gcc/ada/libgnat/a-wtgeau.adb b/gcc/ada/libgnat/a-wtgeau.adb index ed823f1..39b8776 100644 --- a/gcc/ada/libgnat/a-wtgeau.adb +++ b/gcc/ada/libgnat/a-wtgeau.adb @@ -343,7 +343,6 @@ package body Ada.Wide_Text_IO.Generic_Aux is Ptr : in out Integer) is Junk : Boolean; - pragma Unreferenced (Junk); begin Load_Extended_Digits (File, Buf, Ptr, Junk); end Load_Extended_Digits; diff --git a/gcc/ada/libgnat/a-ztgeau.adb b/gcc/ada/libgnat/a-ztgeau.adb index 9a4fdb0..0659d25 100644 --- a/gcc/ada/libgnat/a-ztgeau.adb +++ b/gcc/ada/libgnat/a-ztgeau.adb @@ -343,7 +343,6 @@ package body Ada.Wide_Wide_Text_IO.Generic_Aux is Ptr : in out Integer) is Junk : Boolean; - pragma Unreferenced (Junk); begin Load_Extended_Digits (File, Buf, Ptr, Junk); end Load_Extended_Digits; diff --git a/gcc/ada/libgnat/g-calend.adb b/gcc/ada/libgnat/g-calend.adb index 8200b60..f073f1e 100644 --- a/gcc/ada/libgnat/g-calend.adb +++ b/gcc/ada/libgnat/g-calend.adb @@ -44,7 +44,6 @@ package body GNAT.Calendar is Month : Month_Number; Day : Day_Number; Day_Secs : Day_Duration; - pragma Unreferenced (Day_Secs); begin Split (Date, Year, Month, Day, Day_Secs); return Julian_Day (Year, Month, Day) - Julian_Day (Year, 1, 1) + 1; @@ -59,7 +58,6 @@ package body GNAT.Calendar is Month : Month_Number; Day : Day_Number; Day_Secs : Day_Duration; - pragma Unreferenced (Day_Secs); begin Split (Date, Year, Month, Day, Day_Secs); return Day_Name'Val ((Julian_Day (Year, Month, Day)) mod 7); @@ -77,7 +75,6 @@ package body GNAT.Calendar is Minute : Minute_Number; Second : Second_Number; Sub_Second : Second_Duration; - pragma Unreferenced (Year, Month, Day, Minute, Second, Sub_Second); begin Split (Date, Year, Month, Day, Hour, Minute, Second, Sub_Second); return Hour; @@ -137,7 +134,6 @@ package body GNAT.Calendar is Minute : Minute_Number; Second : Second_Number; Sub_Second : Second_Duration; - pragma Unreferenced (Year, Month, Day, Hour, Second, Sub_Second); begin Split (Date, Year, Month, Day, Hour, Minute, Second, Sub_Second); return Minute; @@ -155,7 +151,6 @@ package body GNAT.Calendar is Minute : Minute_Number; Second : Second_Number; Sub_Second : Second_Duration; - pragma Unreferenced (Year, Month, Day, Hour, Minute, Sub_Second); begin Split (Date, Year, Month, Day, Hour, Minute, Second, Sub_Second); return Second; @@ -222,8 +217,6 @@ package body GNAT.Calendar is Ds : Day_Duration; Le : Boolean; - pragma Unreferenced (Ds, Le); - begin -- Even though the input time zone is UTC (0), the flag Use_TZ will -- ensure that Split picks up the local time zone. ???But Use_TZ is @@ -257,7 +250,6 @@ package body GNAT.Calendar is Minute : Minute_Number; Second : Second_Number; Sub_Second : Second_Duration; - pragma Unreferenced (Year, Month, Day, Hour, Minute, Second); begin Split (Date, Year, Month, Day, Hour, Minute, Second, Sub_Second); return Sub_Second; @@ -398,7 +390,6 @@ package body GNAT.Calendar is function Week_In_Year (Date : Time) return Week_In_Year_Number is Year : Year_Number; Week : Week_In_Year_Number; - pragma Unreferenced (Year); begin Year_Week_In_Year (Date, Year, Week); return Week; @@ -423,8 +414,6 @@ package body GNAT.Calendar is Shift : Week_In_Year_Number; Start_Week : Week_In_Year_Number; - pragma Unreferenced (Hour, Minute, Second, Sub_Second); - function Is_Leap (Year : Year_Number) return Boolean; -- Return True if Year denotes a leap year. Leap centennial years are -- properly handled. diff --git a/gcc/ada/libgnat/g-comlin.adb b/gcc/ada/libgnat/g-comlin.adb index 4cbfd57..09a765d 100644 --- a/gcc/ada/libgnat/g-comlin.adb +++ b/gcc/ada/libgnat/g-comlin.adb @@ -2235,7 +2235,6 @@ package body GNAT.Command_Line is Add_Before : Boolean := False) is Success : Boolean; - pragma Unreferenced (Success); begin Add_Switch (Cmd, Switch, Parameter, Separator, Section, Add_Before, Success); @@ -2453,7 +2452,6 @@ package body GNAT.Command_Line is Section : String := "") is Success : Boolean; - pragma Unreferenced (Success); begin Remove_Switch (Cmd, Switch, Remove_All, Has_Parameter, Section, Success); end Remove_Switch; diff --git a/gcc/ada/libgnat/g-expect.adb b/gcc/ada/libgnat/g-expect.adb index 89ede30..de045ac 100644 --- a/gcc/ada/libgnat/g-expect.adb +++ b/gcc/ada/libgnat/g-expect.adb @@ -264,7 +264,6 @@ package body GNAT.Expect is procedure Close (Descriptor : in out Process_Descriptor) is Status : Integer; - pragma Unreferenced (Status); begin Close (Descriptor, Status); end Close; @@ -976,7 +975,6 @@ package body GNAT.Expect is declare Result : Expect_Match; - pragma Unreferenced (Result); begin -- This loop runs until the call to Expect raises Process_Died @@ -1439,7 +1437,7 @@ package body GNAT.Expect is Pipe3 : not null access Pipe_Type) is Status : Boolean; - pragma Unreferenced (Status); + pragma Warnings (Off, "modified by call, but value overwritten"); begin -- Create the pipes diff --git a/gcc/ada/libgnat/g-mbflra.adb b/gcc/ada/libgnat/g-mbflra.adb index a35787b..174e44c 100644 --- a/gcc/ada/libgnat/g-mbflra.adb +++ b/gcc/ada/libgnat/g-mbflra.adb @@ -118,7 +118,6 @@ package body GNAT.MBBS_Float_Random is function Euclid (P, Q : Int) return Int is X, Y, GCD : Int; - pragma Unreferenced (Y, GCD); begin Euclid (P, Q, X, Y, GCD); return X; diff --git a/gcc/ada/libgnat/g-spipat.adb b/gcc/ada/libgnat/g-spipat.adb index 353a92d..845a77d 100644 --- a/gcc/ada/libgnat/g-spipat.adb +++ b/gcc/ada/libgnat/g-spipat.adb @@ -2836,7 +2836,6 @@ package body GNAT.Spitbol.Patterns is L : Natural; Start : Natural; Stop : Natural; - pragma Unreferenced (Stop); begin Get_String (Subject, S, L); @@ -2855,7 +2854,6 @@ package body GNAT.Spitbol.Patterns is Pat : Pattern) return Boolean is Start, Stop : Natural; - pragma Unreferenced (Stop); subtype String1 is String (1 .. Subject'Length); @@ -2935,7 +2933,6 @@ package body GNAT.Spitbol.Patterns is Start : Natural; Stop : Natural; - pragma Unreferenced (Start, Stop); begin Get_String (Subject, S, L); @@ -2952,7 +2949,6 @@ package body GNAT.Spitbol.Patterns is Pat : Pattern) is Start, Stop : Natural; - pragma Unreferenced (Start, Stop); subtype String1 is String (1 .. Subject'Length); @@ -3135,7 +3131,6 @@ package body GNAT.Spitbol.Patterns is Start : Natural; Stop : Natural; - pragma Unreferenced (Start, Stop); begin Get_String (Subject, S, L); @@ -3152,7 +3147,6 @@ package body GNAT.Spitbol.Patterns is Pat : PString) is Start, Stop : Natural; - pragma Unreferenced (Start, Stop); subtype String1 is String (1 .. Subject'Length); diff --git a/gcc/ada/libgnat/s-fatgen.adb b/gcc/ada/libgnat/s-fatgen.adb index e591cca..77a1a98 100644 --- a/gcc/ada/libgnat/s-fatgen.adb +++ b/gcc/ada/libgnat/s-fatgen.adb @@ -194,7 +194,6 @@ package body System.Fat_Gen is function Compose (Fraction : T; Exponent : UI) return T is Arg_Frac : T; Arg_Exp : UI; - pragma Unreferenced (Arg_Exp); begin Decompose (Fraction, Arg_Frac, Arg_Exp); return Scaling (Arg_Frac, Exponent); @@ -285,7 +284,6 @@ package body System.Fat_Gen is function Exponent (X : T) return UI is X_Frac : T; X_Exp : UI; - pragma Unreferenced (X_Frac); begin Decompose (X, X_Frac, X_Exp); return X_Exp; @@ -487,7 +485,6 @@ package body System.Fat_Gen is function Fraction (X : T) return T is X_Frac : T; X_Exp : UI; - pragma Unreferenced (X_Exp); begin Decompose (X, X_Frac, X_Exp); return X_Frac; @@ -624,7 +621,6 @@ package body System.Fat_Gen is P_Even : Boolean; Arg_Frac : T; - pragma Unreferenced (Arg_Frac); begin if Y = 0.0 then diff --git a/gcc/ada/libgnat/s-fileio.adb b/gcc/ada/libgnat/s-fileio.adb index 152cd96..0a7ed3a 100644 --- a/gcc/ada/libgnat/s-fileio.adb +++ b/gcc/ada/libgnat/s-fileio.adb @@ -576,7 +576,6 @@ package body System.File_IO is Default : Boolean) return Boolean is V1, V2 : Natural; - pragma Unreferenced (V2); begin Form_Parameter (Form, Keyword, V1, V2); diff --git a/gcc/ada/libgnat/s-os_lib.adb b/gcc/ada/libgnat/s-os_lib.adb index e3f6b12..043f530 100644 --- a/gcc/ada/libgnat/s-os_lib.adb +++ b/gcc/ada/libgnat/s-os_lib.adb @@ -1211,7 +1211,6 @@ package body System.OS_Lib is H : Hour_Type; Mn : Minute_Type; S : Second_Type; - pragma Unreferenced (Y, Mo, H, Mn, S); begin GM_Split (Date, Y, Mo, D, H, Mn, S); @@ -1230,7 +1229,6 @@ package body System.OS_Lib is D : Day_Type; Mn : Minute_Type; S : Second_Type; - pragma Unreferenced (Y, Mo, D, Mn, S); begin GM_Split (Date, Y, Mo, D, H, Mn, S); @@ -1249,7 +1247,6 @@ package body System.OS_Lib is D : Day_Type; H : Hour_Type; S : Second_Type; - pragma Unreferenced (Y, Mo, D, H, S); begin GM_Split (Date, Y, Mo, D, H, Mn, S); @@ -1268,7 +1265,6 @@ package body System.OS_Lib is H : Hour_Type; Mn : Minute_Type; S : Second_Type; - pragma Unreferenced (Y, D, H, Mn, S); begin GM_Split (Date, Y, Mo, D, H, Mn, S); @@ -1287,7 +1283,6 @@ package body System.OS_Lib is D : Day_Type; H : Hour_Type; Mn : Minute_Type; - pragma Unreferenced (Y, Mo, D, H, Mn); begin GM_Split (Date, Y, Mo, D, H, Mn, S); @@ -1425,7 +1420,6 @@ package body System.OS_Lib is H : Hour_Type; Mn : Minute_Type; S : Second_Type; - pragma Unreferenced (Mo, D, H, Mn, S); begin GM_Split (Date, Y, Mo, D, H, Mn, S); diff --git a/gcc/ada/libgnat/s-regpat.adb b/gcc/ada/libgnat/s-regpat.adb index 00833bb..f1c0f87 100644 --- a/gcc/ada/libgnat/s-regpat.adb +++ b/gcc/ada/libgnat/s-regpat.adb @@ -1974,7 +1974,6 @@ package body System.Regpat is Result : Pointer; Expr_Flags : Expression_Flags; - pragma Unreferenced (Expr_Flags); -- Start of processing for Compile @@ -3582,7 +3581,6 @@ package body System.Regpat is is PM : Pattern_Matcher (Size); Finalize_Size : Program_Size; - pragma Unreferenced (Finalize_Size); begin if Size = 0 then Match (Compile (Expression), Data, Matches, Data_First, Data_Last); @@ -3605,7 +3603,6 @@ package body System.Regpat is is PM : Pattern_Matcher (Size); Final_Size : Program_Size; - pragma Unreferenced (Final_Size); begin if Size = 0 then return Match (Compile (Expression), Data, Data_First, Data_Last); @@ -3629,7 +3626,6 @@ package body System.Regpat is Matches : Match_Array (0 .. 0); PM : Pattern_Matcher (Size); Final_Size : Program_Size; - pragma Unreferenced (Final_Size); begin if Size = 0 then Match (Compile (Expression), Data, Matches, Data_First, Data_Last); diff --git a/gcc/ada/libgnat/s-valued.adb b/gcc/ada/libgnat/s-valued.adb index 100d870..4931e13 100644 --- a/gcc/ada/libgnat/s-valued.adb +++ b/gcc/ada/libgnat/s-valued.adb @@ -232,7 +232,6 @@ package body System.Value_D is Base : Unsigned; ScaleB : Integer; Extra : Unsigned; - pragma Unreferenced (Extra); Minus : Boolean; Val : Uns; @@ -250,7 +249,6 @@ package body System.Value_D is Base : Unsigned; ScaleB : Integer; Extra : Unsigned; - pragma Unreferenced (Extra); Minus : Boolean; Val : Uns; diff --git a/gcc/ada/libgnat/s-valuer.adb b/gcc/ada/libgnat/s-valuer.adb index a1793fa..8b95ba2 100644 --- a/gcc/ada/libgnat/s-valuer.adb +++ b/gcc/ada/libgnat/s-valuer.adb @@ -506,7 +506,6 @@ package body System.Value_R is -- Local copy of string pointer Start : Positive; - pragma Unreferenced (Start); Value : Uns; -- Mantissa as an Integer diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index 4e4f83d..24d897d 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -579,11 +579,6 @@ package body Sem_Ch10 is Error_Msg_N -- CODEFIX ("redundant with clause in body?r?", Clause); end if; - - Used_In_Body := False; - Used_In_Spec := False; - Used_Type_Or_Elab := False; - Withed_In_Spec := False; end; -- Standalone package spec or body check diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index af685f5..dae76b4 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -17131,7 +17131,7 @@ package body Sem_Ch13 is Func_Name : constant Node_Id := Expression (ASN); Overloaded : Boolean := Is_Overloaded (Func_Name); - I : Interp_Index; + I : Interp_Index := 0; It : Interp; Param_Type : Entity_Id; Match_Found : Boolean := False; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index bd51c5b..19da333 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -7059,7 +7059,7 @@ package body Sem_Ch3 is Indic : constant Node_Id := Subtype_Indication (Def); Corr_Record : constant Entity_Id := Make_Temporary (Loc, 'C'); - Corr_Decl : Node_Id; + Corr_Decl : Node_Id := Empty; Corr_Decl_Needed : Boolean; -- If the derived type has fewer discriminants than its parent, the -- corresponding record is also a derived type, in order to account for diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index a70077a..d204e31 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -6432,17 +6432,13 @@ package body Sem_Ch8 is -- Else see if we have a left hand side else - case Is_LHS (N) is - when Yes => + case Known_To_Be_Assigned (N, Only_LHS => True) is + when True => Generate_Reference (E, N, 'm'); - when No => + when False => Generate_Reference (E, N, 'r'); - -- If we don't know now, generate reference later - - when Unknown => - Defer_Reference ((E, N)); end case; end if; end if; @@ -6493,7 +6489,7 @@ package body Sem_Ch8 is if Needs_Variable_Reference_Marker (N => N, Calls_OK => False) then declare - Is_Assignment_LHS : constant Boolean := Is_LHS (N) = Yes; + Is_Assignment_LHS : constant Boolean := Known_To_Be_Assigned (N); begin Build_Variable_Reference_Marker @@ -7086,15 +7082,13 @@ package body Sem_Ch8 is else Set_Entity_Or_Discriminal (N, Id); - case Is_LHS (N) is - when Yes => + case Known_To_Be_Assigned (N, Only_LHS => True) is + when True => Generate_Reference (Id, N, 'm'); - when No => + when False => Generate_Reference (Id, N, 'r'); - when Unknown => - Defer_Reference ((Id, N)); end case; end if; @@ -7190,7 +7184,7 @@ package body Sem_Ch8 is Calls_OK => False) then declare - Is_Assignment_LHS : constant Boolean := Is_LHS (N) = Yes; + Is_Assignment_LHS : constant Boolean := Known_To_Be_Assigned (N); begin Build_Variable_Reference_Marker diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index f85efc2..99ba5d9 100644 --- a/gcc/ada/sem_eval.adb +++ b/gcc/ada/sem_eval.adb @@ -3886,7 +3886,7 @@ package body Sem_Eval is -- Fold will perform the other relevant tests. if Nkind (Parent (N)) /= N_Attribute_Reference - and then Is_LHS (N) = No + and then not Known_To_Be_Assigned (N) and then not Is_Actual_Out_Or_In_Out_Parameter (N) then -- Simplify a selected_component on an aggregate by extracting diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index d05da0d..843e820 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -11070,7 +11070,7 @@ package body Sem_Res is -- resolution was complete to do this, since otherwise we can't tell if -- we are an lvalue or not. - if May_Be_Lvalue (N) then + if Known_To_Be_Assigned (N) then Generate_Reference (Entity (S), S, 'm'); else Generate_Reference (Entity (S), S, 'r'); @@ -11096,7 +11096,7 @@ package body Sem_Res is if Is_Entity_Name (P) and then Has_Deferred_Reference (Entity (P)) then - if May_Be_Lvalue (N) then + if Known_To_Be_Assigned (N) then Generate_Reference (Entity (P), P, 'm'); else Generate_Reference (Entity (P), P, 'r'); diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 88181ab..38d8483 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -8361,7 +8361,7 @@ package body Sem_Util is -- Local variables - Owner : Node_Id; + Owner : Node_Id := Empty; -- Start of processing for End_Keyword_Location @@ -8979,7 +8979,7 @@ package body Sem_Util is function Expression_Of_Expression_Function (Subp : Entity_Id) return Node_Id is - Expr_Func : Node_Id; + Expr_Func : Node_Id := Empty; begin pragma Assert (Is_Expression_Function_Or_Completion (Subp)); @@ -9158,6 +9158,12 @@ package body Sem_Util is then Call_Nam := Name (Call); + -- A call to an entry family may appear as an indexed component + + if Nkind (Call_Nam) = N_Indexed_Component then + Call_Nam := Prefix (Call_Nam); + end if; + -- A call to a protected or task entry appears as a selected -- component rather than an expanded name. @@ -9167,7 +9173,11 @@ package body Sem_Util is if Is_Entity_Name (Call_Nam) and then Present (Entity (Call_Nam)) - and then Is_Overloadable (Entity (Call_Nam)) + and then (Is_Generic_Subprogram (Entity (Call_Nam)) + or else Is_Overloadable (Entity (Call_Nam)) + or else Ekind (Entity (Call_Nam)) in E_Entry_Family + | E_Subprogram_Body + | E_Subprogram_Type) and then not Is_Overloaded (Call_Nam) then -- If node is name in call it is not an actual @@ -18252,60 +18262,124 @@ package body Sem_Util is return Is_Array_Type (Container_Typ); end Is_Iterator_Over_Array; - ------------ - -- Is_LHS -- - ------------ + -------------------------- + -- Known_To_Be_Assigned -- + -------------------------- - -- We seem to have a lot of overlapping functions that do similar things - -- (testing for left hand sides or lvalues???). + function Known_To_Be_Assigned + (N : Node_Id; + Only_LHS : Boolean := False) return Boolean + is + function Known_Assn (N : Node_Id) return Boolean is + (Known_To_Be_Assigned (N, Only_LHS)); + -- Local function to simplify the passing of parameters for recursive + -- calls. - function Is_LHS (N : Node_Id) return Is_LHS_Result is - P : constant Node_Id := Parent (N); + P : constant Node_Id := Parent (N); + Form : Entity_Id := Empty; + Call : Node_Id := Empty; + + -- Start of processing for Known_To_Be_Assigned begin - -- Return True if we are the left hand side of an assignment statement + -- Check for out parameters - if Nkind (P) = N_Assignment_Statement then - if Name (P) = N then - return Yes; - else - return No; - end if; + Find_Actual (N, Form, Call); - -- Case of prefix of indexed or selected component or slice + if Present (Form) then + return Ekind (Form) /= E_In_Parameter and then not Only_LHS; + end if; - elsif Nkind (P) in N_Indexed_Component | N_Selected_Component | N_Slice - and then N = Prefix (P) - then - -- Here we have the case where the parent P is N.Q or N(Q .. R). - -- If P is an LHS, then N is also effectively an LHS, but there - -- is an important exception. If N is of an access type, then - -- what we really have is N.all.Q (or N.all(Q .. R)). In either - -- case this makes N.all a left hand side but not N itself. + -- Otherwise look at the parent - -- If we don't know the type yet, this is the case where we return - -- Unknown, since the answer depends on the type which is unknown. + case Nkind (P) is - if No (Etype (N)) then - return Unknown; + -- Test left side of assignment - -- We have an Etype set, so we can check it + when N_Assignment_Statement => + return N = Name (P); - elsif Is_Access_Type (Etype (N)) then - return No; + -- Test prefix of component or attribute. Note that the prefix of an + -- explicit or implicit dereference cannot be an l-value. In the case + -- of a 'Read attribute, the reference can be an actual in the + -- argument list of the attribute. - -- OK, not access type case, so just test whole expression + when N_Attribute_Reference => + return + not Only_LHS and then + ((N = Prefix (P) + and then Name_Implies_Lvalue_Prefix (Attribute_Name (P))) + or else + Attribute_Name (P) = Name_Read); - else - return Is_LHS (P); - end if; + -- For an expanded name, the name is an lvalue if the expanded name + -- is an lvalue, but the prefix is never an lvalue, since it is just + -- the scope where the name is found. + + when N_Expanded_Name => + if N = Prefix (P) then + return Known_Assn (P); + else + return False; + end if; - -- All other cases are not left hand sides + -- For a selected component A.B, A is certainly an lvalue if A.B is. + -- B is a little interesting, if we have A.B := 3, there is some + -- discussion as to whether B is an lvalue or not, we choose to say + -- it is. Note however that A is not an lvalue if it is of an access + -- type since this is an implicit dereference. - else - return No; - end if; - end Is_LHS; + when N_Selected_Component => + if N = Prefix (P) + and then Present (Etype (N)) + and then Is_Access_Type (Etype (N)) + then + return False; + else + return Known_Assn (P); + end if; + + -- For an indexed component or slice, the index or slice bounds is + -- never an lvalue. The prefix is an lvalue if the indexed component + -- or slice is an lvalue, except if it is an access type, where we + -- have an implicit dereference. + + when N_Indexed_Component | N_Slice => + if N /= Prefix (P) + or else (Present (Etype (N)) and then Is_Access_Type (Etype (N))) + then + return False; + else + return Known_Assn (P); + end if; + + -- Prefix of a reference is an lvalue if the reference is an lvalue + + when N_Reference => + return Known_Assn (P); + + -- Prefix of explicit dereference is never an lvalue + + when N_Explicit_Dereference => + return False; + + -- Test for appearing in a conversion that itself appears in an + -- lvalue context, since this should be an lvalue. + + when N_Type_Conversion => + return Known_Assn (P); + + -- Test for appearance in object renaming declaration + + when N_Object_Renaming_Declaration => + return not Only_LHS; + + -- All other references are definitely not lvalues + + when others => + return False; + end case; + end Known_To_Be_Assigned; ----------------------------- -- Is_Library_Level_Entity -- @@ -22149,121 +22223,6 @@ package body Sem_Util is return False; end Known_Null; - -------------------------- - -- Known_To_Be_Assigned -- - -------------------------- - - function Known_To_Be_Assigned (N : Node_Id) return Boolean is - P : constant Node_Id := Parent (N); - - begin - case Nkind (P) is - - -- Test left side of assignment - - when N_Assignment_Statement => - return N = Name (P); - - -- Function call arguments are never lvalues - - when N_Function_Call => - return False; - - -- Positional parameter for procedure or accept call - - when N_Accept_Statement - | N_Procedure_Call_Statement - => - declare - Proc : Entity_Id; - Form : Entity_Id; - Act : Node_Id; - - begin - Proc := Get_Subprogram_Entity (P); - - if No (Proc) then - return False; - end if; - - -- If we are not a list member, something is strange, so - -- be conservative and return False. - - if not Is_List_Member (N) then - return False; - end if; - - -- We are going to find the right formal by stepping forward - -- through the formals, as we step backwards in the actuals. - - Form := First_Formal (Proc); - Act := N; - loop - -- If no formal, something is weird, so be conservative - -- and return False. - - if No (Form) then - return False; - end if; - - Prev (Act); - exit when No (Act); - Next_Formal (Form); - end loop; - - return Ekind (Form) /= E_In_Parameter; - end; - - -- Named parameter for procedure or accept call - - when N_Parameter_Association => - declare - Proc : Entity_Id; - Form : Entity_Id; - - begin - Proc := Get_Subprogram_Entity (Parent (P)); - - if No (Proc) then - return False; - end if; - - -- Loop through formals to find the one that matches - - Form := First_Formal (Proc); - loop - -- If no matching formal, that's peculiar, some kind of - -- previous error, so return False to be conservative. - -- Actually this also happens in legal code in the case - -- where P is a parameter association for an Extra_Formal??? - - if No (Form) then - return False; - end if; - - -- Else test for match - - if Chars (Form) = Chars (Selector_Name (P)) then - return Ekind (Form) /= E_In_Parameter; - end if; - - Next_Formal (Form); - end loop; - end; - - -- Test for appearing in a conversion that itself appears - -- in an lvalue context, since this should be an lvalue. - - when N_Type_Conversion => - return Known_To_Be_Assigned (P); - - -- All other references are definitely not known to be modifications - - when others => - return False; - end case; - end Known_To_Be_Assigned; - --------------------------- -- Last_Source_Statement -- --------------------------- @@ -22749,195 +22708,6 @@ package body Sem_Util is return True; end Matching_Static_Array_Bounds; - ------------------- - -- May_Be_Lvalue -- - ------------------- - - function May_Be_Lvalue (N : Node_Id) return Boolean is - P : constant Node_Id := Parent (N); - - begin - case Nkind (P) is - - -- Test left side of assignment - - when N_Assignment_Statement => - return N = Name (P); - - -- Test prefix of component or attribute. Note that the prefix of an - -- explicit or implicit dereference cannot be an l-value. In the case - -- of a 'Read attribute, the reference can be an actual in the - -- argument list of the attribute. - - when N_Attribute_Reference => - return (N = Prefix (P) - and then Name_Implies_Lvalue_Prefix (Attribute_Name (P))) - or else - Attribute_Name (P) = Name_Read; - - -- For an expanded name, the name is an lvalue if the expanded name - -- is an lvalue, but the prefix is never an lvalue, since it is just - -- the scope where the name is found. - - when N_Expanded_Name => - if N = Prefix (P) then - return May_Be_Lvalue (P); - else - return False; - end if; - - -- For a selected component A.B, A is certainly an lvalue if A.B is. - -- B is a little interesting, if we have A.B := 3, there is some - -- discussion as to whether B is an lvalue or not, we choose to say - -- it is. Note however that A is not an lvalue if it is of an access - -- type since this is an implicit dereference. - - when N_Selected_Component => - if N = Prefix (P) - and then Present (Etype (N)) - and then Is_Access_Type (Etype (N)) - then - return False; - else - return May_Be_Lvalue (P); - end if; - - -- For an indexed component or slice, the index or slice bounds is - -- never an lvalue. The prefix is an lvalue if the indexed component - -- or slice is an lvalue, except if it is an access type, where we - -- have an implicit dereference. - - when N_Indexed_Component - | N_Slice - => - if N /= Prefix (P) - or else (Present (Etype (N)) and then Is_Access_Type (Etype (N))) - then - return False; - else - return May_Be_Lvalue (P); - end if; - - -- Prefix of a reference is an lvalue if the reference is an lvalue - - when N_Reference => - return May_Be_Lvalue (P); - - -- Prefix of explicit dereference is never an lvalue - - when N_Explicit_Dereference => - return False; - - -- Positional parameter for subprogram, entry, or accept call. - -- In older versions of Ada function call arguments are never - -- lvalues. In Ada 2012 functions can have in-out parameters. - - when N_Accept_Statement - | N_Entry_Call_Statement - | N_Subprogram_Call - => - if Nkind (P) = N_Function_Call and then Ada_Version < Ada_2012 then - return False; - end if; - - -- The following mechanism is clumsy and fragile. A single flag - -- set in Resolve_Actuals would be preferable ??? - - declare - Proc : Entity_Id; - Form : Entity_Id; - Act : Node_Id; - - begin - Proc := Get_Subprogram_Entity (P); - - if No (Proc) then - return True; - end if; - - -- If we are not a list member, something is strange, so be - -- conservative and return True. - - if not Is_List_Member (N) then - return True; - end if; - - -- We are going to find the right formal by stepping forward - -- through the formals, as we step backwards in the actuals. - - Form := First_Formal (Proc); - Act := N; - loop - -- If no formal, something is weird, so be conservative and - -- return True. - - if No (Form) then - return True; - end if; - - Prev (Act); - exit when No (Act); - Next_Formal (Form); - end loop; - - return Ekind (Form) /= E_In_Parameter; - end; - - -- Named parameter for procedure or accept call - - when N_Parameter_Association => - declare - Proc : Entity_Id; - Form : Entity_Id; - - begin - Proc := Get_Subprogram_Entity (Parent (P)); - - if No (Proc) then - return True; - end if; - - -- Loop through formals to find the one that matches - - Form := First_Formal (Proc); - loop - -- If no matching formal, that's peculiar, some kind of - -- previous error, so return True to be conservative. - -- Actually happens with legal code for an unresolved call - -- where we may get the wrong homonym??? - - if No (Form) then - return True; - end if; - - -- Else test for match - - if Chars (Form) = Chars (Selector_Name (P)) then - return Ekind (Form) /= E_In_Parameter; - end if; - - Next_Formal (Form); - end loop; - end; - - -- Test for appearing in a conversion that itself appears in an - -- lvalue context, since this should be an lvalue. - - when N_Type_Conversion => - return May_Be_Lvalue (P); - - -- Test for appearance in object renaming declaration - - when N_Object_Renaming_Declaration => - return True; - - -- All other references are definitely not lvalues - - when others => - return False; - end case; - end May_Be_Lvalue; - ----------------- -- Might_Raise -- ----------------- diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 0006cf9..911cc2d 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -2159,16 +2159,6 @@ package Sem_Util is -- an array, either inside a loop of the form 'for X of A' or a quantified -- expression of the form 'for all/some X of A' where A is of array type. - type Is_LHS_Result is (Yes, No, Unknown); - function Is_LHS (N : Node_Id) return Is_LHS_Result; - -- Returns Yes if N is definitely used as Name in an assignment statement. - -- Returns No if N is definitely NOT used as a Name in an assignment - -- statement. Returns Unknown if we can't tell at this stage (happens in - -- the case where we don't know the type of N yet, and we have something - -- like N.A := 3, where this counts as N being used on the left side of - -- an assignment only if N is not an access type. If it is an access type - -- then it is N.all.A that is assigned, not N. - function Is_Library_Level_Entity (E : Entity_Id) return Boolean; -- A library-level declaration is one that is accessible from Standard, -- i.e. a library unit or an entity declared in a library package. @@ -2589,12 +2579,13 @@ package Sem_Util is -- and returns True if so. Returns False otherwise. It is an error to call -- this function if N is not of an access type. - function Known_To_Be_Assigned (N : Node_Id) return Boolean; + function Known_To_Be_Assigned + (N : Node_Id; + Only_LHS : Boolean := False) return Boolean; -- The node N is an entity reference. This function determines whether the -- reference is for sure an assignment of the entity, returning True if - -- so. This differs from May_Be_Lvalue in that it defaults in the other - -- direction. Cases which may possibly be assignments but are not known to - -- be may return True from May_Be_Lvalue, but False from this function. + -- so. Only_LHS will modify this behavior such that actuals for out or + -- in out parameters will not be considered assigned. function Last_Source_Statement (HSS : Node_Id) return Node_Id; -- HSS is a handled statement sequence. This function returns the last @@ -2633,17 +2624,6 @@ package Sem_Util is -- same number of dimensions, and the same static bounds for each index -- position. - function May_Be_Lvalue (N : Node_Id) return Boolean; - -- Determines if N could be an lvalue (e.g. an assignment left hand side). - -- An lvalue is defined as any expression which appears in a context where - -- a name is required by the syntax, and the identity, rather than merely - -- the value of the node is needed (for example, the prefix of an Access - -- attribute is in this category). Note that, as implied by the name, this - -- test is conservative. If it cannot be sure that N is NOT an lvalue, then - -- it returns True. It tries hard to get the answer right, but it is hard - -- to guarantee this in all cases. Note that it is more possible to give - -- correct answer if the tree is fully analyzed. - function Might_Raise (N : Node_Id) return Boolean; -- True if evaluation of N might raise an exception. This is conservative; -- if we're not sure, we return True. If N is a subprogram body, this is diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index 951b9f80..85d5365 100644 --- a/gcc/ada/sem_warn.adb +++ b/gcc/ada/sem_warn.adb @@ -513,7 +513,7 @@ package body Sem_Warn is -- If this is an lvalue, then definitely abandon, since -- this could be a direct modification of the variable. - if May_Be_Lvalue (N) then + if Known_To_Be_Assigned (N) then return Abandon; end if; @@ -559,7 +559,7 @@ package body Sem_Warn is and then Present (Renamed_Object (Entity (N))) and then Is_Entity_Name (Renamed_Object (Entity (N))) and then Entity (Renamed_Object (Entity (N))) = Var - and then May_Be_Lvalue (N) + and then Known_To_Be_Assigned (N) then return Abandon; @@ -4596,10 +4596,11 @@ package body Sem_Warn is if Nkind (Parent (LA)) in N_Parameter_Association | N_Procedure_Call_Statement then - Error_Msg_NE - ("?m?& modified by call, but value might not be " - & "referenced", LA, Ent); - + if Warn_On_All_Unread_Out_Parameters then + Error_Msg_NE + ("?m?& modified by call, but value might not " + & "be referenced", LA, Ent); + end if; else Error_Msg_NE -- CODEFIX ("?m?possibly useless assignment to&, value " |