From 140d20770a6f3ce67519b88a6db1026d57831dd6 Mon Sep 17 00:00:00 2001 From: charlet Date: Wed, 11 Jun 2014 10:49:33 +0000 Subject: [PATCH] 2014-06-11 Gary Dismukes * sem_util.adb: Minor typo fix. 2014-06-11 Ed Schonberg * sem_warn.adb (Check_References): Do not emit spurious warnings on uninitialzed variable of a formal private type if variable is not read. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@211446 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 10 ++ gcc/ada/sem_util.adb | 6 +- gcc/ada/sem_warn.adb | 331 +++++++++++++++++++++++---------------------------- 3 files changed, 160 insertions(+), 187 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 7cbfba0..0a404e0 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,13 @@ +2014-06-11 Gary Dismukes + + * sem_util.adb: Minor typo fix. + +2014-06-11 Ed Schonberg + + * sem_warn.adb (Check_References): Do not emit spurious warnings + on uninitialzed variable of a formal private type if variable + is not read. + 2014-06-09 Jan Hubicka * gcc-interface/utils.c (process_attributes) : Use diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index afb62c1..ba472b9 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -687,9 +687,9 @@ package body Sem_Util is end if; end Bad_Predicated_Subtype_Use; - ---------------------------------------- + ----------------------------------------- -- Bad_Unordered_Enumeration_Reference -- - ---------------------------------------- + ----------------------------------------- function Bad_Unordered_Enumeration_Reference (N : Node_Id; @@ -15908,7 +15908,7 @@ package body Sem_Util is -- Remaining checks are only done on source nodes. Note that we test -- for violation of No_Fixed_IO even on non-source nodes, because the -- cases for checking violations of this restriction are instantiations - -- where the refernece in the instance has Comes_From_Source False. + -- where the reference in the instance has Comes_From_Source False. if not Comes_From_Source (N) then return; diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index 6571a9e..2859599 100644 --- a/gcc/ada/sem_warn.adb +++ b/gcc/ada/sem_warn.adb @@ -327,9 +327,7 @@ package body Sem_Warn is begin -- One argument, so check the argument - if Present (PA) - and then List_Length (PA) = 1 - then + if Present (PA) and then List_Length (PA) = 1 then if Nkind (First (PA)) = N_Parameter_Association then Find_Var (Explicit_Actual_Parameter (First (PA))); else @@ -415,9 +413,7 @@ package body Sem_Warn is begin for J in 1 .. Name_Len - (Len - 1) loop if Name_Buffer (J .. J + (Len - 1)) = S - and then - (J = 1 - or else Name_Buffer (J - 1) not in 'a' .. 'z') + and then (J = 1 or else Name_Buffer (J - 1) not in 'a' .. 'z') and then (J + Len > Name_Len or else Name_Buffer (J + Len) not in 'a' .. 'z') @@ -841,8 +837,8 @@ package body Sem_Warn is Res := True; elsif (Nkind (Par)) = N_Formal_Type_Declaration - and then Nkind (Formal_Type_Definition (Par)) - = N_Formal_Private_Type_Definition + and then Nkind (Formal_Type_Definition (Par)) = + N_Formal_Private_Type_Definition then Set_Needs_Initialized_Actual (Formal_Type_Definition (Par)); Res := True; @@ -984,8 +980,8 @@ package body Sem_Warn is when N_Generic_Package_Declaration => return not Is_List_Member (Prev) - or else List_Containing (Prev) - /= Generic_Formal_Declarations (P); + or else List_Containing (Prev) /= + Generic_Formal_Declarations (P); -- Similarly, the generic formals of a generic subprogram are -- not accessible. @@ -1051,9 +1047,7 @@ package body Sem_Warn is -- real errors so far (this last check avoids junk messages resulting -- from errors, e.g. a subunit that is not loaded). - if Warning_Mode = Suppress - or else Serious_Errors_Detected /= 0 - then + if Warning_Mode = Suppress or else Serious_Errors_Detected /= 0 then return; end if; @@ -1101,9 +1095,8 @@ package body Sem_Warn is -- Special processing for access types - if Present (UR) - and then Is_Access_Type (E1T) - then + if Present (UR) and then Is_Access_Type (E1T) then + -- For access types, the only time we made a UR entry was -- for a dereference, and so we post the appropriate warning -- here (note that the dereference may not be explicit in @@ -1125,7 +1118,7 @@ package body Sem_Warn is elsif Warn_On_Constant and then (Ekind (E1) = E_Variable - and then Has_Initial_Value (E1)) + and then Has_Initial_Value (E1)) and then Never_Set_In_Source_Check_Spec (E1) and then not Address_Taken (E1) and then not Generic_Package_Spec_Entity (E1) @@ -1173,35 +1166,35 @@ package body Sem_Warn is elsif Never_Set_In_Source_Check_Spec (E1) - -- No warning if warning for this case turned off + -- No warning if warning for this case turned off - and then Warn_On_No_Value_Assigned + and then Warn_On_No_Value_Assigned - -- No warning if address taken somewhere + -- No warning if address taken somewhere - and then not Address_Taken (E1) + and then not Address_Taken (E1) - -- No warning if explicit initial value + -- No warning if explicit initial value - and then not Has_Initial_Value (E1) + and then not Has_Initial_Value (E1) - -- No warning for generic package spec entities, since we - -- might set them in a child unit or something like that + -- No warning for generic package spec entities, since we + -- might set them in a child unit or something like that - and then not Generic_Package_Spec_Entity (E1) + and then not Generic_Package_Spec_Entity (E1) - -- No warning if fully initialized type, except that for - -- this purpose we do not consider access types to qualify - -- as fully initialized types (relying on an access type - -- variable being null when it is never set is a bit odd). + -- No warning if fully initialized type, except that for + -- this purpose we do not consider access types to qualify + -- as fully initialized types (relying on an access type + -- variable being null when it is never set is a bit odd). - -- Also we generate warning for an out parameter that is - -- never referenced, since again it seems odd to rely on - -- default initialization to set an out parameter value. + -- Also we generate warning for an out parameter that is + -- never referenced, since again it seems odd to rely on + -- default initialization to set an out parameter value. - and then (Is_Access_Type (E1T) - or else Ekind (E1) = E_Out_Parameter - or else not Is_Fully_Initialized_Type (E1T)) + and then (Is_Access_Type (E1T) + or else Ekind (E1) = E_Out_Parameter + or else not Is_Fully_Initialized_Type (E1T)) then -- Do not output complaint about never being assigned a -- value if a pragma Unmodified applies to the variable @@ -1321,7 +1314,6 @@ package body Sem_Warn is elsif not Has_Unreferenced (E1) and then not Warnings_Off_E1 and then not Is_Junk_Name (Chars (E1)) - and then not May_Need_Initialized_Actual (E1) then Output_Reference_Error -- CODEFIX ("?v?variable& is never read and never assigned!"); @@ -1460,134 +1452,125 @@ package body Sem_Warn is if not Referenced_Check_Spec (E1) - -- If Referenced_As_LHS is set, then that's still interesting - -- (potential "assigned but never read" case), but not if we - -- have pragma Unreferenced, which cancels this warning. + -- If Referenced_As_LHS is set, then that's still interesting + -- (potential "assigned but never read" case), but not if we + -- have pragma Unreferenced, which cancels this warning. and then (not Referenced_As_LHS_Check_Spec (E1) - or else not Has_Unreferenced (E1)) + or else not Has_Unreferenced (E1)) - -- Check that warnings on unreferenced entities are enabled + -- Check that warnings on unreferenced entities are enabled and then ((Check_Unreferenced and then not Is_Formal (E1)) - -- Case of warning on unreferenced formal - - or else - (Check_Unreferenced_Formals and then Is_Formal (E1)) - - -- Case of warning on unread variables modified by an - -- assignment, or an OUT parameter if it is the only one. - - or else - (Warn_On_Modified_Unread - and then Referenced_As_LHS_Check_Spec (E1)) - - -- Case of warning on any unread OUT parameter (note - -- such indications are only set if the appropriate - -- warning options were set, so no need to recheck here.) - - or else - Referenced_As_Out_Parameter_Check_Spec (E1)) - - -- All other entities, including local packages that cannot be - -- referenced from elsewhere, including those declared within a - -- package body. - - and then (Is_Object (E1) - or else - Is_Type (E1) - or else - Ekind (E1) = E_Label - or else - Ekind (E1) = E_Exception - or else - Ekind (E1) = E_Named_Integer - or else - Ekind (E1) = E_Named_Real - or else - Is_Overloadable (E1) - - -- Package case, if the main unit is a package spec - -- or generic package spec, then there may be a - -- corresponding body that references this package - -- in some other file. Otherwise we can be sure - -- that there is no other reference. - - or else - (Ekind (E1) = E_Package - and then - not Is_Package_Or_Generic_Package - (Cunit_Entity (Current_Sem_Unit)))) + -- Case of warning on unreferenced formal + + or else (Check_Unreferenced_Formals and then Is_Formal (E1)) + + -- Case of warning on unread variables modified by an + -- assignment, or an OUT parameter if it is the only one. + + or else (Warn_On_Modified_Unread + and then Referenced_As_LHS_Check_Spec (E1)) + + -- Case of warning on any unread OUT parameter (note such + -- indications are only set if the appropriate warning + -- options were set, so no need to recheck here.) + + or else Referenced_As_Out_Parameter_Check_Spec (E1)) + + -- All other entities, including local packages that cannot be + -- referenced from elsewhere, including those declared within a + -- package body. + + and then (Is_Object (E1) + or else Is_Type (E1) + or else Ekind (E1) = E_Label + or else Ekind_In (E1, E_Exception, + E_Named_Integer, + E_Named_Real) + or else Is_Overloadable (E1) - -- Exclude instantiations, since there is no reason why every - -- entity in an instantiation should be referenced. + -- Package case, if the main unit is a package spec + -- or generic package spec, then there may be a + -- corresponding body that references this package + -- in some other file. Otherwise we can be sure + -- that there is no other reference. - and then Instantiation_Location (Sloc (E1)) = No_Location + or else + (Ekind (E1) = E_Package + and then + not Is_Package_Or_Generic_Package + (Cunit_Entity (Current_Sem_Unit)))) - -- Exclude formal parameters from bodies if the corresponding - -- spec entity has been referenced in the case where there is - -- a separate spec. + -- Exclude instantiations, since there is no reason why every + -- entity in an instantiation should be referenced. - and then not (Is_Formal (E1) - and then Ekind (Scope (E1)) = E_Subprogram_Body - and then Present (Spec_Entity (E1)) - and then Referenced (Spec_Entity (E1))) + and then Instantiation_Location (Sloc (E1)) = No_Location - -- Consider private type referenced if full view is referenced. - -- If there is not full view, this is a generic type on which - -- warnings are also useful. + -- Exclude formal parameters from bodies if the corresponding + -- spec entity has been referenced in the case where there is + -- a separate spec. - and then - not (Is_Private_Type (E1) - and then Present (Full_View (E1)) - and then Referenced (Full_View (E1))) + and then not (Is_Formal (E1) + and then Ekind (Scope (E1)) = E_Subprogram_Body + and then Present (Spec_Entity (E1)) + and then Referenced (Spec_Entity (E1))) - -- Don't worry about full view, only about private type + -- Consider private type referenced if full view is referenced. + -- If there is not full view, this is a generic type on which + -- warnings are also useful. - and then not Has_Private_Declaration (E1) + and then + not (Is_Private_Type (E1) + and then Present (Full_View (E1)) + and then Referenced (Full_View (E1))) + + -- Don't worry about full view, only about private type - -- Eliminate dispatching operations from consideration, we - -- cannot tell if these are referenced or not in any easy - -- manner (note this also catches Adjust/Finalize/Initialize). + and then not Has_Private_Declaration (E1) - and then not Is_Dispatching_Operation (E1) + -- Eliminate dispatching operations from consideration, we + -- cannot tell if these are referenced or not in any easy + -- manner (note this also catches Adjust/Finalize/Initialize). - -- Check entity that can be publicly referenced (we do not give - -- messages for such entities, since there could be other - -- units, not involved in this compilation, that contain - -- relevant references. + and then not Is_Dispatching_Operation (E1) - and then not Publicly_Referenceable (E1) + -- Check entity that can be publicly referenced (we do not give + -- messages for such entities, since there could be other + -- units, not involved in this compilation, that contain + -- relevant references. + + and then not Publicly_Referenceable (E1) - -- Class wide types are marked as source entities, but they are - -- not really source entities, and are always created, so we do - -- not care if they are not referenced. + -- Class wide types are marked as source entities, but they are + -- not really source entities, and are always created, so we do + -- not care if they are not referenced. - and then Ekind (E1) /= E_Class_Wide_Type + and then Ekind (E1) /= E_Class_Wide_Type - -- Objects other than parameters of task types are allowed to - -- be non-referenced, since they start up tasks. + -- Objects other than parameters of task types are allowed to + -- be non-referenced, since they start up tasks. - and then ((Ekind (E1) /= E_Variable - and then Ekind (E1) /= E_Constant - and then Ekind (E1) /= E_Component) - or else not Is_Task_Type (E1T)) + and then ((Ekind (E1) /= E_Variable + and then Ekind (E1) /= E_Constant + and then Ekind (E1) /= E_Component) + or else not Is_Task_Type (E1T)) - -- For subunits, only place warnings on the main unit itself, - -- since parent units are not completely compiled. + -- For subunits, only place warnings on the main unit itself, + -- since parent units are not completely compiled. - and then (Nkind (Unit (Cunit (Main_Unit))) /= N_Subunit - or else Get_Source_Unit (E1) = Main_Unit) + and then (Nkind (Unit (Cunit (Main_Unit))) /= N_Subunit + or else Get_Source_Unit (E1) = Main_Unit) - -- No warning on a return object, because these are often - -- created with a single expression and an implicit return. - -- If the object is a variable there will be a warning - -- indicating that it could be declared constant. + -- No warning on a return object, because these are often + -- created with a single expression and an implicit return. + -- If the object is a variable there will be a warning + -- indicating that it could be declared constant. - and then not - (Ekind (E1) = E_Constant and then Is_Return_Object (E1)) + and then not + (Ekind (E1) = E_Constant and then Is_Return_Object (E1)) then -- Suppress warnings in internal units if not in -gnatg mode -- (these would be junk warnings for an applications program, @@ -1648,10 +1631,10 @@ package body Sem_Warn is <> if (Is_Package_Or_Generic_Package (E1) - and then Nkind (Parent (E1)) = N_Package_Specification - and then - Nkind (Original_Node (Unit_Declaration_Node (E1))) - /= N_Formal_Package_Declaration) + and then Nkind (Parent (E1)) = N_Package_Specification + and then + Nkind (Original_Node (Unit_Declaration_Node (E1))) /= + N_Formal_Package_Declaration) or else Ekind (E1) = E_Block then @@ -1770,9 +1753,7 @@ package body Sem_Warn is E : constant Entity_Id := Entity (N); begin - if (Ekind (E) = E_Variable - or else - Ekind (E) = E_Out_Parameter) + if Ekind_In (E, E_Variable, E_Out_Parameter) and then Never_Set_In_Source_Check_Spec (E) and then not Has_Initial_Value (E) and then (No (Unset_Reference (E)) @@ -1860,10 +1841,8 @@ package body Sem_Warn is P := Parent (Nod); if Nkind (P) = N_Pragma - and then - Pragma_Name (P) = Name_Test_Case - and then - Nod = Get_Ensures_From_CTC_Pragma (P) + and then Pragma_Name (P) = Name_Test_Case + and then Nod = Get_Ensures_From_CTC_Pragma (P) then return True; end if; @@ -1977,10 +1956,8 @@ package body Sem_Warn is P := Parent (P); exit when No (P); - if (Nkind (P) = N_If_Statement - or else - Nkind (P) = N_Elsif_Part) - and then Ref_In (Condition (P)) + if Nkind_In (P, N_If_Statement, N_Elsif_Part) + and then Ref_In (Condition (P)) then return; @@ -2272,9 +2249,7 @@ package body Sem_Warn is E1 := First_Entity (P); while Present (E1) loop - if Ekind (E1) = E_Package - and then Renamed_Object (E1) = L - then + if Ekind (E1) = E_Package and then Renamed_Object (E1) = L then Is_Visible_Renaming := not Is_Hidden (E1); return E1; @@ -2321,12 +2296,8 @@ package body Sem_Warn is E := First_Entity (P); end if; - while Present (E) - and then E /= First_Private_Entity (P) - loop - if Comes_From_Source (E) - or else Present (Limited_View (P)) - then + while Present (E) and then E /= First_Private_Entity (P) loop + if Comes_From_Source (E) or else Present (Limited_View (P)) then return True; end if; @@ -2364,16 +2335,15 @@ package body Sem_Warn is Item := First (Context_Items (Cnode)); while Present (Item) loop if Nkind (Item) = N_With_Clause - and then not Implicit_With (Item) - and then In_Extended_Main_Source_Unit (Item) + and then not Implicit_With (Item) + and then In_Extended_Main_Source_Unit (Item) then Lunit := Entity (Name (Item)); -- Check if this unit is referenced (skip the check if this -- is explicitly marked by a pragma Unreferenced). - if not Referenced (Lunit) - and then not Has_Unreferenced (Lunit) + if not Referenced (Lunit) and then not Has_Unreferenced (Lunit) then -- Suppress warnings in internal units if not in -gnatg mode -- (these would be junk warnings for an application program, @@ -2688,9 +2658,7 @@ package body Sem_Warn is function Goto_Spec_Entity (E : Entity_Id) return Entity_Id is begin - if Is_Formal (E) - and then Present (Spec_Entity (E)) - then + if Is_Formal (E) and then Present (Spec_Entity (E)) then return Spec_Entity (E); else return E; @@ -3217,9 +3185,7 @@ package body Sem_Warn is Track (Left_Opnd (Nod), Loc); Track (Right_Opnd (Nod), Loc); - elsif Is_Entity_Name (Nod) - and then Is_Object (Entity (Nod)) - then + elsif Is_Entity_Name (Nod) and then Is_Object (Entity (Nod)) then declare CV : constant Node_Id := Current_Value (Entity (Nod)); @@ -3343,8 +3309,7 @@ package body Sem_Warn is Cond : Node_Id := C; begin - if Present (Parent (C)) - and then Nkind (Parent (C)) = N_Op_Not + if Present (Parent (C)) and then Nkind (Parent (C)) = N_Op_Not then True_Branch := not True_Branch; Cond := Parent (C); @@ -3479,9 +3444,9 @@ package body Sem_Warn is Present (Underlying_Type (Etype (Form1))) and then (Is_By_Reference_Type (Underlying_Type (Etype (Form1))) - or else - Convention (Underlying_Type (Etype (Form1))) = - Convention_Ada_Pass_By_Reference) + or else + Convention (Underlying_Type (Etype (Form1))) = + Convention_Ada_Pass_By_Reference) then null; @@ -3673,9 +3638,9 @@ package body Sem_Warn is begin return Nkind (R) = N_Attribute_Reference - and then Attribute_Name (R) = Name_Length - and then Is_Entity_Name (Prefix (R)) - and then Entity (Prefix (R)) = Ent; + and then Attribute_Name (R) = Name_Length + and then Is_Entity_Name (Prefix (R)) + and then Entity (Prefix (R)) = Ent; end Length_Reference; ----------- @@ -3777,7 +3742,7 @@ package body Sem_Warn is exit when Pctr = 0 and then (Tref (Sref .. Sref + 1) = ".." - or else + or else Tref (Sref .. Sref + 2) = " .."); -- Quit if we have hit EOF character, something wrong @@ -4132,9 +4097,7 @@ package body Sem_Warn is -- is not quite right, but it really does not matter that we fail -- to output the warning in some obscure cases of name clashes. - if Nkind (N) = N_Identifier - and then Chars (N) = Chars (Ent) - then + if Nkind (N) = N_Identifier and then Chars (N) = Chars (Ent) then return Abandon; else return OK; -- 2.7.4