+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.
-- 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;
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;
then
LB := T_LB;
Known_LB := True;
-
- else
- Known_LB := False;
end if;
-- Likewise for the high bound
then
HB := T_HB;
Known_HB := True;
- else
- Known_HB := False;
end if;
end if;
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
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
-- 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;
-- 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;
-- 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)
-- --
-- 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- --
-- 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;
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
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;
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
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
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
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;
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));
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
-- 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);
-- 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)));
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
-----------------------
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;
-- 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
---------------------------------
procedure Derive_Interface_Subprogram
- (New_Subp : in out Entity_Id;
+ (New_Subp : out Entity_Id;
Subp : Entity_Id;
Actual_Subp : Entity_Id)
is
-- --
-- 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- --
-- 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;
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
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;
-- 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);
-- --
-- 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- --
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
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
(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
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);
-- --
-- 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- --
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;
-- --
-- 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- --
-- 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;
projects / gcc.git / commitdiff