diff options
-rw-r--r-- | gcc/ada/ChangeLog | 50 | ||||
-rw-r--r-- | gcc/ada/checks.adb | 13 | ||||
-rw-r--r-- | gcc/ada/errout.adb | 11 | ||||
-rw-r--r-- | gcc/ada/frontend.adb | 7 | ||||
-rw-r--r-- | gcc/ada/inline.adb | 9 | ||||
-rw-r--r-- | gcc/ada/prep.adb | 10 | ||||
-rw-r--r-- | gcc/ada/sem_aggr.adb | 18 | ||||
-rw-r--r-- | gcc/ada/sem_ch10.adb | 29 | ||||
-rw-r--r-- | gcc/ada/sem_ch12.adb | 8 | ||||
-rw-r--r-- | gcc/ada/sem_ch3.adb | 6 | ||||
-rw-r--r-- | gcc/ada/sem_ch3.ads | 4 | ||||
-rw-r--r-- | gcc/ada/sem_ch4.adb | 4 | ||||
-rw-r--r-- | gcc/ada/sem_ch6.adb | 5 | ||||
-rw-r--r-- | gcc/ada/sem_elim.adb | 7 | ||||
-rw-r--r-- | gcc/ada/sem_eval.adb | 7 | ||||
-rw-r--r-- | gcc/ada/sem_util.adb | 2 | ||||
-rw-r--r-- | gcc/ada/snames.adb-tmpl | 3 | ||||
-rw-r--r-- | gcc/ada/treepr.adb | 8 |
18 files changed, 118 insertions, 83 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 090654b..ffdbb4a 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,53 @@ +2016-07-04 Bob Duff <duff@adacore.com> + + * sem_eval.adb (Decompose_Expr): Set 'out' parameters + Kind and Cons to valid values, to avoid use of uninit vars. + (Extract_Length): Reorder the check to make it clearer that + we're depending on BOTH Ent1 and Ent2 to be Present. + * sem_aggr.adb (Resolve_Aggregate): Remove dead code. + (Check_Misspelled_Component): Remove exit statement, because + it's covered by the 'while' condition. + * checks.adb (Apply_Selected_Range_Checks): Remove useless + condition "or else not Checks_On". + (Selected_Range_Checks): + Initialize Known_LB and Known_HB to False, because they are + tested unconditionally; avoid use of uninit vars. + * frontend.adb (Frontend): Removed useless condition + "Operating_Mode = Check_Semantics and then", and added an Assert + to clarify why it was useless. + * prep.adb (Preprocess): Remove redundant condition. Add an + assertion. + * sem_ch10.adb (Analyze_Proper_Body): Moved redundant condition + "Original_Operating_Mode = Generate_Code" to an Assert. + (Process_Spec_Clauses, Process_Body_Clauses): Change parameters + from 'in out' to 'out', and don't initialize actuals. + * sem_ch12.adb (Is_In_Main_Unit): Removed useless condition + "Unum = Main_Unit or else". + (Save_Global_Descendant): Moved + redundant condition "D = Union_Id (No_List)" to an Assert. + * sem_ch4.adb (Check_Misspelled_Selector): Remove exit + statement, because it's covered by the 'while' condition. + (Analyze_Case_Expression): Initialize Wrong_Alt to Empty, + because it looks like it is used uninitialized otherwise. + * sem_ch6.adb (Check_Return_Subtype_Indication): Moved redundant + condition "not R_Type_Is_Anon_Access" to an Assert. + * sem_elim.adb (Line_Num_Match): Moved redundant condition + "Sloc_Trace (Idx) = '['" to an Assert. + * sem_util.adb (Compile_Time_Constraint_Error): Change "J" to + "J - 1". This code is trying to replace "?" with "<", but not if + the "?" is quoted, as in "'?", so we want to check the PREVIOUS + character for '''. + * snames.adb-tmpl (Is_Pragma_Name): Remove useless condition + "or else N = Name_Relative_Deadline". It's useless because + Name_Relative_Deadline is in the range First_Pragma_Name + .. Last_Pragma_Name. + * treepr.adb (Visit_Node): Moved redundant condition "D = + Union_Id (No_List)" to an Assert. + * sem_ch3.adb (Derive_Subprogram, Derive_Subprograms): Change + parameters from 'in out' to 'out'. + * errout.adb (Error_Msg_Internal): Replace redundant test with Assert. + * inline.adb (Add_Inlined_Body): Code cleanup. + 2016-07-04 Hristian Kirtchev <kirtchev@adacore.com> * g-sercom-mingw.adb, sem_ch6.adb: Minor reformatting. diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 961e4b5..d91d64b 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -3243,9 +3243,7 @@ package body Checks is -- on, then we want to delete the check, since it is not needed. -- We do this by replacing the if statement by a null statement - -- Why are we even generating checks if checks are turned off ??? - - elsif Do_Static or else not Checks_On then + elsif Do_Static then Remove_Warning_Messages (R_Cno); Rewrite (R_Cno, Make_Null_Statement (Loc)); end if; @@ -9650,8 +9648,8 @@ package body Checks is LB : Node_Id := Low_Bound (Ck_Node); HB : Node_Id := High_Bound (Ck_Node); - Known_LB : Boolean; - Known_HB : Boolean; + Known_LB : Boolean := False; + Known_HB : Boolean := False; Null_Range : Boolean; Out_Of_Range_L : Boolean; @@ -9673,9 +9671,6 @@ package body Checks is then LB := T_LB; Known_LB := True; - - else - Known_LB := False; end if; -- Likewise for the high bound @@ -9688,8 +9683,6 @@ package body Checks is then HB := T_HB; Known_HB := True; - else - Known_HB := False; end if; end if; diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb index 1c794de..0b5de5c 100644 --- a/gcc/ada/errout.adb +++ b/gcc/ada/errout.adb @@ -1082,8 +1082,7 @@ package body Errout is end loop; end if; - -- Now we insert the new message in the error chain. The insertion - -- point for the message is after Prev_Msg and before Next_Msg. + -- Now we insert the new message in the error chain. -- The possible insertion point for the new message is after Prev_Msg -- and before Next_Msg. However, this is where we do a special check @@ -1101,7 +1100,7 @@ package body Errout is and then not All_Errors_Mode then -- Don't delete unconditional messages and at this stage, don't - -- delete continuation lines (we attempted to delete those earlier + -- delete continuation lines; we attempted to delete those earlier -- if the parent message was deleted. if not Errors.Table (Cur_Msg).Uncond @@ -1125,10 +1124,8 @@ package body Errout is -- All tests passed, delete the message by simply returning -- without any further processing. - if not Continuation then - Last_Killed := True; - end if; - + pragma Assert (not Continuation); + Last_Killed := True; return; end if; end if; diff --git a/gcc/ada/frontend.adb b/gcc/ada/frontend.adb index 3861903..16f2a25 100644 --- a/gcc/ada/frontend.adb +++ b/gcc/ada/frontend.adb @@ -410,9 +410,12 @@ begin -- Comment needed for ASIS mode test and GNATprove mode test??? + pragma Assert + (Operating_Mode = Generate_Code + or else Operating_Mode = Check_Semantics); + if Operating_Mode = Generate_Code - or else (Operating_Mode = Check_Semantics - and then (ASIS_Mode or GNATprove_Mode)) + or else (ASIS_Mode or GNATprove_Mode) then Instantiate_Bodies; end if; diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index d205636..1be03ae 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -459,11 +459,12 @@ package body Inline is -- Do not inline it either if it is in the main unit. -- Extend the -gnatn2 processing to -gnatn1 for Inline_Always -- calls if the back-end takes care of inlining the call. + -- Note that Level in Inline_Package | Inline_Call here. - elsif (Level = Inline_Package - or else (Level = Inline_Call - and then Has_Pragma_Inline_Always (E) - and then Back_End_Inlining)) + elsif ((Level = Inline_Call + and then Has_Pragma_Inline_Always (E) + and then Back_End_Inlining) + or else Level = Inline_Package) and then not Is_Inlined (Pack) and then not Is_Internal (E) and then not In_Main_Unit_Or_Subunit (Pack) diff --git a/gcc/ada/prep.adb b/gcc/ada/prep.adb index d5672ba..6f401ed 100644 --- a/gcc/ada/prep.adb +++ b/gcc/ada/prep.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2002-2015, Free Software Foundation, Inc. -- +-- Copyright (C) 2002-2016, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -1562,14 +1562,12 @@ package body Prep is -- so we have to deduct Start_Of_Processing from the token pointer. if Token = Tok_End_Of_Line then - if (Sinput.Source (Token_Ptr) = ASCII.CR - and then Sinput.Source (Token_Ptr + 1) = ASCII.LF) - or else - (Sinput.Source (Token_Ptr) = ASCII.CR - and then Sinput.Source (Token_Ptr + 1) = ASCII.LF) + if Sinput.Source (Token_Ptr) = ASCII.CR + and then Sinput.Source (Token_Ptr + 1) = ASCII.LF then Start_Of_Processing := Token_Ptr + 2; else + pragma Assert (Sinput.Source (Token_Ptr) = ASCII.LF); Start_Of_Processing := Token_Ptr + 1; end if; end if; diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index feb1a4a..4f24ab2 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -647,9 +647,9 @@ package body Sem_Aggr is begin -- All the components of List are matched against Component and a count - -- is maintained of possible misspellings. When at the end of the the + -- is maintained of possible misspellings. When at the end of the -- analysis there are one or two (not more) possible misspellings, - -- these misspellings will be suggested as possible correction. + -- these misspellings will be suggested as possible corrections. Component_Elmt := First_Elmt (Elements); while Nr_Of_Suggestions <= Max_Suggestions @@ -664,7 +664,7 @@ package body Sem_Aggr is case Nr_Of_Suggestions is when 1 => Suggestion_1 := Node (Component_Elmt); when 2 => Suggestion_2 := Node (Component_Elmt); - when others => exit; + when others => null; end case; end if; @@ -1094,18 +1094,6 @@ package body Sem_Aggr is Index_Constr => First_Index (Typ), Component_Typ => Component_Type (Typ), Others_Allowed => True); - - elsif not Expander_Active - and then Pkind = N_Assignment_Statement - then - Aggr_Resolved := - Resolve_Array_Aggregate - (N, - Index => First_Index (Aggr_Typ), - Index_Constr => First_Index (Typ), - Component_Typ => Component_Type (Typ), - Others_Allowed => True); - else Aggr_Resolved := Resolve_Array_Aggregate diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index d4cd883..86dbad0 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -269,8 +269,8 @@ package body Sem_Ch10 is procedure Process_Body_Clauses (Context_List : List_Id; Clause : Node_Id; - Used : in out Boolean; - Used_Type_Or_Elab : in out Boolean); + Used : out Boolean; + Used_Type_Or_Elab : out Boolean); -- Examine the context clauses of a package body, trying to match the -- name entity of Clause with any list element. If the match occurs -- on a use package clause set Used to True, for a use type clause or @@ -279,8 +279,8 @@ package body Sem_Ch10 is procedure Process_Spec_Clauses (Context_List : List_Id; Clause : Node_Id; - Used : in out Boolean; - Withed : in out Boolean; + Used : out Boolean; + Withed : out Boolean; Exit_On_Self : Boolean := False); -- Examine the context clauses of a package spec, trying to match -- the name entity of Clause with any list element. If the match @@ -298,8 +298,8 @@ package body Sem_Ch10 is procedure Process_Body_Clauses (Context_List : List_Id; Clause : Node_Id; - Used : in out Boolean; - Used_Type_Or_Elab : in out Boolean) + Used : out Boolean; + Used_Type_Or_Elab : out Boolean) is Nam_Ent : constant Entity_Id := Entity (Name (Clause)); Cont_Item : Node_Id; @@ -419,8 +419,8 @@ package body Sem_Ch10 is procedure Process_Spec_Clauses (Context_List : List_Id; Clause : Node_Id; - Used : in out Boolean; - Withed : in out Boolean; + Used : out Boolean; + Withed : out Boolean; Exit_On_Self : Boolean := False) is Nam_Ent : constant Entity_Id := Entity (Name (Clause)); @@ -515,10 +515,10 @@ package body Sem_Ch10 is if Present (Spec_Context_Items) then declare - Used_In_Body : Boolean := False; - Used_In_Spec : Boolean := False; - Used_Type_Or_Elab : Boolean := False; - Withed_In_Spec : Boolean := False; + Used_In_Body : Boolean; + Used_In_Spec : Boolean; + Used_Type_Or_Elab : Boolean; + Withed_In_Spec : Boolean; begin Process_Spec_Clauses @@ -1834,9 +1834,8 @@ package body Sem_Ch10 is -- Give message if we did not get the unit Emit warning even if -- missing subunit is not within main unit, to simplify debugging. - if Original_Operating_Mode = Generate_Code - and then Unum = No_Unit - then + pragma Assert (Original_Operating_Mode = Generate_Code); + if Unum = No_Unit then Error_Msg_Unit_1 := Subunit_Name; Error_Msg_File_1 := Get_File_Name (Subunit_Name, Subunit => True); diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 3648146..02fe102 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -12855,8 +12855,7 @@ package body Sem_Ch12 is -- or in the declaration of the main unit, which in this last case must -- be a body. - return Unum = Main_Unit - or else Current_Unit = Cunit (Main_Unit) + return Current_Unit = Cunit (Main_Unit) or else Current_Unit = Library_Unit (Cunit (Main_Unit)) or else (Present (Library_Unit (Current_Unit)) and then Is_In_Main_Unit (Library_Unit (Current_Unit))); @@ -14575,7 +14574,10 @@ package body Sem_Ch12 is end if; elsif D in List_Range then - if D = Union_Id (No_List) or else Is_Empty_List (List_Id (D)) then + pragma Assert (D /= Union_Id (No_List)); + -- Because No_List = Empty, which is in Node_Range above + + if Is_Empty_List (List_Id (D)) then null; else diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 16d3e73..f18551c 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -14501,7 +14501,7 @@ package body Sem_Ch3 is ----------------------- procedure Derive_Subprogram - (New_Subp : in out Entity_Id; + (New_Subp : out Entity_Id; Parent_Subp : Entity_Id; Derived_Type : Entity_Id; Parent_Type : Entity_Id; @@ -15082,7 +15082,7 @@ package body Sem_Ch3 is -- the list of primitives of Derived_Type exactly in the same order. procedure Derive_Interface_Subprogram - (New_Subp : in out Entity_Id; + (New_Subp : out Entity_Id; Subp : Entity_Id; Actual_Subp : Entity_Id); -- Derive New_Subp from the ultimate alias of the parent subprogram Subp @@ -15168,7 +15168,7 @@ package body Sem_Ch3 is --------------------------------- procedure Derive_Interface_Subprogram - (New_Subp : in out Entity_Id; + (New_Subp : out Entity_Id; Subp : Entity_Id; Actual_Subp : Entity_Id) is diff --git a/gcc/ada/sem_ch3.ads b/gcc/ada/sem_ch3.ads index 57184ed5..9f4c6cf 100644 --- a/gcc/ada/sem_ch3.ads +++ b/gcc/ada/sem_ch3.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -120,7 +120,7 @@ package Sem_Ch3 is -- expressions because the constructor (if any) is on the C++ side. procedure Derive_Subprogram - (New_Subp : in out Entity_Id; + (New_Subp : out Entity_Id; Parent_Subp : Entity_Id; Derived_Type : Entity_Id; Parent_Type : Entity_Id; diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 596e8c6..30ef491 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -1490,7 +1490,7 @@ package body Sem_Ch4 is Others_Present : Boolean; -- Indicates if Others was present - Wrong_Alt : Node_Id; + Wrong_Alt : Node_Id := Empty; -- For error reporting -- Start of processing for Analyze_Case_Expression @@ -5696,7 +5696,7 @@ package body Sem_Ch4 is case Nr_Of_Suggestions is when 1 => Suggestion_1 := Comp; when 2 => Suggestion_2 := Comp; - when others => exit; + when others => null; end case; end if; end if; diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 66434f82..a91d62e 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -774,9 +774,8 @@ package body Sem_Ch6 is -- If the return object is of an anonymous access type, then report -- an error if the function's result type is not also anonymous. - elsif R_Stm_Type_Is_Anon_Access - and then not R_Type_Is_Anon_Access - then + elsif R_Stm_Type_Is_Anon_Access then + pragma Assert (not R_Type_Is_Anon_Access); Error_Msg_N ("anonymous access not allowed for function with " & "named access result", Subtype_Ind); diff --git a/gcc/ada/sem_elim.adb b/gcc/ada/sem_elim.adb index b784f6d..f61a41c 100644 --- a/gcc/ada/sem_elim.adb +++ b/gcc/ada/sem_elim.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1997-2015, Free Software Foundation, Inc. -- +-- Copyright (C) 1997-2016, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -599,9 +599,8 @@ package body Sem_Elim is Idx := Idx + 1; end loop; - if Idx <= Last and then - Sloc_Trace (Idx) = '[' - then + if Idx <= Last then + pragma Assert (Sloc_Trace (Idx) = '['); Idx := Idx + 1; Idx := Skip_Spaces; else diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index 5589394..6ce9363 100644 --- a/gcc/ada/sem_eval.adb +++ b/gcc/ada/sem_eval.adb @@ -3224,6 +3224,11 @@ package body Sem_Eval is begin Ent := Empty; + -- Ignored values: + + Kind := '?'; + Cons := No_Uint; + if Nkind (Expr) = N_Op_Add and then Compile_Time_Known_Value (Right_Opnd (Expr)) then @@ -3311,8 +3316,8 @@ package body Sem_Eval is (Original_Node (Type_High_Bound (T)), Ent2, Kind2, Cons2); if Present (Ent1) - and then Kind1 = Kind2 and then Ent1 = Ent2 + and then Kind1 = Kind2 then Len := Cons2 - Cons1 + 1; else diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 94e97b4..fd6421c 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -4865,7 +4865,7 @@ package body Sem_Util is Msgl := Msg'Length; for J in 1 .. Msgl loop - if Msg (J) = '?' and then (J = 1 or else Msg (J) /= ''') then + if Msg (J) = '?' and then (J = 1 or else Msg (J - 1) /= ''') then Msgc (J) := '<'; else Msgc (J) := Msg (J); diff --git a/gcc/ada/snames.adb-tmpl b/gcc/ada/snames.adb-tmpl index 3de2b82..6b6c598 100644 --- a/gcc/ada/snames.adb-tmpl +++ b/gcc/ada/snames.adb-tmpl @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -455,7 +455,6 @@ package body Snames is or else N = Name_Interface or else N = Name_Interrupt_Priority or else N = Name_Lock_Free - or else N = Name_Relative_Deadline or else N = Name_Priority or else N = Name_Storage_Size or else N = Name_Storage_Unit; diff --git a/gcc/ada/treepr.adb b/gcc/ada/treepr.adb index 9933cf7..27662dd 100644 --- a/gcc/ada/treepr.adb +++ b/gcc/ada/treepr.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2015, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -1998,8 +1998,10 @@ package body Treepr is -- Don't bother with a missing list, empty list or error list - if D = Union_Id (No_List) - or else D = Union_Id (Error_List) + pragma Assert (D /= Union_Id (No_List)); + -- Because No_List = Empty, which is in Node_Range above + + if D = Union_Id (Error_List) or else Is_Empty_List (List_Id (D)) then return; |