Running CodePeer on GNAT frontend codebase revealed a number of code
quality issues. For the most part, these are not bugs, but could lead to
bugs during maintenance. A few could lead to reads of uninitialized
variables.
This patch fixes these issues in various ways:
- add initialization in cases where this decreases the risk to read an
uninitialized variable one day (and a few where an uninitialized seem
actually doable)
- type more tightly variables
- mark procedures which do not return normally as No_Return
- mark IN OUT parameters which are not modified as Unmodified
- rescope more tightly declarations and statements to make it simpler
for CodePeer to analyze
Tested on x86_64-pc-linux-gnu, committed on trunk
2017-11-09 Yannick Moy <m...@adacore.com>
* binde.adb (Diagnose_Elaboration_Problem): Mark procedure No_Return.
* checks.adb (Apply_Scalar_Range_Check): Rescope variable OK closer to
use. Default initialize Hi, Lo.
(Selected_Range_Checks): Retype Num_Checks more precisely.
(Determine_Range, Determine_Range_R): Default initialize Hi_Right,
Lo_Right.
* contracts.adb (Process_Contract_Cases): Mark parameter Stmts as
Unmodified.
(Process_Postconditions): Mark parameter Stmts as Unmodified.
* exp_attr.adb (Expand_Loop_Entry_Attribute): Default initialize Blk.
* exp_ch4.adb (Expand_N_Allocator): Default initialize Typ.
(Expand_Concatenate): Default initialize High_Bound.
(Optimize_Length_Comparison): Default initialize Ent, Index.
* exp_ch5.adb (Expand_Predicated_Loop): Default initialize L_Hi and
L_Lo.
* exp_ch6.adb (Expand_N_Extended_Return_Statement): Default initialize
Return_Stmt.
* exp_ch9.adb (Expand_Entry_Barrier): Default initialize Func_Body and
remove pragma Warnings(Off).
* exp_imgv.adb (Expand_Image_Attribute): Default initialize Tent.
* exp_util.adb (Find_Interface_Tag): Default initialize AI_Tag.
* freeze.adb (Check_Component_Storage_Order): Default initialize
Comp_Byte_Aligned rather than silencing messages with pragma
Warnings(Off), which does not work for CodePeer initialization
messages, and given that here the possible read of an unitialized value
depends on a proper use of parameters by the caller.
* inline.adb (Expand_Inlined_Call): Default initialize Lab_Decl, Targ.
* sem_ch12.adb (Build_Operator_Wrapper): Default initialize Expr.
* sem_ch3.adb (Build_Derived_Array_Type): Default initialize
Implicit_Base.
* sem_ch4.adb (List_Operand_Interps): Default initialize Nam and remove
pragma Warnings(Off).
(Analyze_Case_Expression): Rescope checking block within branch where
Others_Present is set by the call to Check_Choices.
* sem_ch5.adb (Analyze_Assignment): Default initialize
Save_Full_Analysis.
* sem_ch6.adb (Analyze_Function_Return): Default initialize Obj_Decl,
and restructure code to defend against previous errors, so that, in
that case, control does not flow to the elsif condition which read an
uninitialized Obj_Decl.
* sem_ch9.adb (Analyze_Requeue): Default initialize Synch_Type.
(Check_Interfaces): Default initialize Full_T_Ifaces and Priv_T_Ifaces,
which seem to be left uninitialized and possibly read in some cases.
* sem_dim.adb (Analyze_Aspect_Dimension_System): Retype Position more
precisely. This requires to exchange the test for exiting in case of
too many positions and the increment to Position, inside the loop.
* sem_eval.adb (Eval_Concatenation): Default initialize Folded_Val,
which cannot be read uninitialized, but the reasons for that are quite
subtle.
* sem_intr.adb (Check_Intrinsic_Call): Default initialize Rtyp.
* sem_prag.adb (Collect_Subprogram_Inputs_Outputs): Default initialize
Spec_Id.
* sem_res.adb (Make_Call_Into_Operator): Default initialize Opnd_Type,
and test for presence of non-null Opnd_Type before testing its scope,
in a test which would read its value uninitialized, and is very rarely
exercized (it depends on the presence of an extension of System).
* sem_spark.ads: Update comment to fix name of main analysis procedure.
* sem_warn.adb (Warn_On_Known_Condition): Default initialize
Test_Result.
* set_targ.adb (FailN): Mark procedure with No_Return.
* stylesw.adb (Save_Style_Check_Options): Delete useless code to
initialize all array Options to white space, as there is already code
doing the same for the remaining positions in Options at the end of the
procedure.
Index: exp_ch5.adb
===================================================================
--- exp_ch5.adb (revision 254563)
+++ exp_ch5.adb (working copy)
@@ -4769,8 +4769,8 @@
-- If the domain is an itype, note the bounds of its range.
- L_Hi : Node_Id;
- L_Lo : Node_Id;
+ L_Hi : Node_Id := Empty;
+ L_Lo : Node_Id := Empty;
function Lo_Val (N : Node_Id) return Node_Id;
-- Given static expression or static range, returns an identifier
Index: sem_eval.adb
===================================================================
--- sem_eval.adb (revision 254563)
+++ sem_eval.adb (working copy)
@@ -2301,7 +2301,7 @@
Left_Str : constant Node_Id := Get_String_Val (Left);
Left_Len : Nat;
Right_Str : constant Node_Id := Get_String_Val (Right);
- Folded_Val : String_Id;
+ Folded_Val : String_Id := No_String;
begin
-- Establish new string literal, and store left operand. We make
Index: checks.adb
===================================================================
--- checks.adb (revision 254563)
+++ checks.adb (working copy)
@@ -2765,7 +2765,6 @@
S_Typ : Entity_Id;
Arr : Node_Id := Empty; -- initialize to prevent warning
Arr_Typ : Entity_Id := Empty; -- initialize to prevent warning
- OK : Boolean := False; -- initialize to prevent warning
Is_Subscr_Ref : Boolean;
-- Set true if Expr is a subscript
@@ -2995,10 +2994,11 @@
and then Compile_Time_Known_Value (Thi)
then
declare
+ OK : Boolean := False; -- initialize to prevent warning
Hiv : constant Uint := Expr_Value (Thi);
Lov : constant Uint := Expr_Value (Tlo);
- Hi : Uint;
- Lo : Uint;
+ Hi : Uint := No_Uint;
+ Lo : Uint := No_Uint;
begin
-- If range is null, we for sure have a constraint error (we
@@ -4370,8 +4370,8 @@
Hi_Left : Uint;
-- Lo and Hi bounds of left operand
- Lo_Right : Uint;
- Hi_Right : Uint;
+ Lo_Right : Uint := No_Uint;
+ Hi_Right : Uint := No_Uint;
-- Lo and Hi bounds of right (or only) operand
Bound : Node_Id;
@@ -4909,8 +4909,8 @@
Hi_Left : Ureal;
-- Lo and Hi bounds of left operand
- Lo_Right : Ureal;
- Hi_Right : Ureal;
+ Lo_Right : Ureal := No_Ureal;
+ Hi_Right : Ureal := No_Ureal;
-- Lo and Hi bounds of right (or only) operand
Bound : Node_Id;
@@ -9814,7 +9814,7 @@
Do_Access : Boolean := False;
Wnode : Node_Id := Warn_Node;
Ret_Result : Check_Result := (Empty, Empty);
- Num_Checks : Integer := 0;
+ Num_Checks : Natural := 0;
procedure Add_Check (N : Node_Id);
-- Adds the action given to Ret_Result if N is non-Empty
Index: sem_spark.ads
===================================================================
--- sem_spark.ads (revision 254563)
+++ sem_spark.ads (working copy)
@@ -27,10 +27,10 @@
-- rules that are enforced are defined in the anti-aliasing section of the
-- SPARK RM 6.4.2
--
--- Analyze_SPARK is called by Gnat1drv, when GNATprove mode is activated. It
--- does an analysis of the source code, looking for code that is considered
--- as SPARK and launches another function called Analyze_Node that will do
--- the whole analysis.
+-- Check_Safe_Pointers is called by Gnat1drv, when GNATprove mode is
+-- activated. It does an analysis of the source code, looking for code that is
+-- considered as SPARK and launches another function called Analyze_Node that
+-- will do the whole analysis.
--
-- A path is an abstraction of a name, of which all indices, slices (for
-- indexed components) and function calls have been abstracted and all
Index: sem_ch3.adb
===================================================================
--- sem_ch3.adb (revision 254563)
+++ sem_ch3.adb (working copy)
@@ -6639,7 +6639,7 @@
Tdef : constant Node_Id := Type_Definition (N);
Indic : constant Node_Id := Subtype_Indication (Tdef);
Parent_Base : constant Entity_Id := Base_Type (Parent_Type);
- Implicit_Base : Entity_Id;
+ Implicit_Base : Entity_Id := Empty;
New_Indic : Node_Id;
procedure Make_Implicit_Base;
@@ -6751,7 +6751,7 @@
N_Subtype_Indication;
D_Constraint : Node_Id;
- New_Constraint : Elist_Id;
+ New_Constraint : Elist_Id := No_Elist;
Old_Disc : Entity_Id;
New_Disc : Entity_Id;
New_N : Node_Id;
Index: sem_prag.adb
===================================================================
--- sem_prag.adb (revision 254569)
+++ sem_prag.adb (working copy)
@@ -28747,7 +28747,7 @@
Depends : Node_Id;
Formal : Entity_Id;
Global : Node_Id;
- Spec_Id : Entity_Id;
+ Spec_Id : Entity_Id := Empty;
Subp_Decl : Node_Id;
Typ : Entity_Id;
Index: sem_ch12.adb
===================================================================
--- sem_ch12.adb (revision 254563)
+++ sem_ch12.adb (working copy)
@@ -5895,8 +5895,7 @@
Present (Next_Formal (First_Formal (Formal_Subp)));
Decl : Node_Id;
- Expr : Node_Id;
- pragma Warnings (Off, Expr);
+ Expr : Node_Id := Empty;
F1, F2 : Entity_Id;
Func : Entity_Id;
Op_Name : Name_Id;
Index: sem_intr.adb
===================================================================
--- sem_intr.adb (revision 254563)
+++ sem_intr.adb (working copy)
@@ -101,7 +101,7 @@
Nam : constant Entity_Id := Entity (Name (N));
Arg1 : constant Node_Id := First_Actual (N);
Typ : Entity_Id;
- Rtyp : Entity_Id;
+ Rtyp : Entity_Id := Empty;
Cnam : Name_Id;
Unam : Node_Id;
Index: exp_ch6.adb
===================================================================
--- exp_ch6.adb (revision 254563)
+++ exp_ch6.adb (working copy)
@@ -4721,9 +4721,11 @@
Exp : Node_Id;
HSS : Node_Id;
Result : Node_Id;
- Return_Stmt : Node_Id;
Stmts : List_Id;
+ Return_Stmt : Node_Id := Empty;
+ -- Force initialization to facilitate static analysis
+
-- Start of processing for Expand_N_Extended_Return_Statement
begin
Index: sem_ch4.adb
===================================================================
--- sem_ch4.adb (revision 254569)
+++ sem_ch4.adb (working copy)
@@ -339,9 +339,8 @@
--------------------------
procedure List_Operand_Interps (Opnd : Node_Id) is
- Nam : Node_Id;
- pragma Warnings (Off, Nam);
- Err : Node_Id := N;
+ Nam : Node_Id := Empty;
+ Err : Node_Id := N;
begin
if Is_Overloaded (Opnd) then
@@ -1720,11 +1719,11 @@
else
Analyze_Choices (Alternatives (N), Exp_Type);
Check_Choices (N, Alternatives (N), Exp_Type, Others_Present);
- end if;
- if Exp_Type = Universal_Integer and then not Others_Present then
- Error_Msg_N
- ("case on universal integer requires OTHERS choice", Expr);
+ if Exp_Type = Universal_Integer and then not Others_Present then
+ Error_Msg_N
+ ("case on universal integer requires OTHERS choice", Expr);
+ end if;
end if;
end Analyze_Case_Expression;
Index: sem_ch5.adb
===================================================================
--- sem_ch5.adb (revision 254563)
+++ sem_ch5.adb (working copy)
@@ -391,7 +391,8 @@
T1 : Entity_Id;
T2 : Entity_Id;
- Save_Full_Analysis : Boolean;
+ Save_Full_Analysis : Boolean := False;
+ -- Force initialization to facilitate static analysis
Saved_GM : constant Ghost_Mode_Type := Ghost_Mode;
-- Save the Ghost mode to restore on exit
Index: freeze.adb
===================================================================
--- freeze.adb (revision 254563)
+++ freeze.adb (working copy)
@@ -1173,8 +1173,7 @@
Component_Aliased : Boolean;
- Comp_Byte_Aligned : Boolean;
- pragma Warnings (Off, Comp_Byte_Aligned);
+ Comp_Byte_Aligned : Boolean := False;
-- Set for the record case, True if Comp is aligned on byte boundaries
-- (in which case it is allowed to have different storage order).
Index: set_targ.adb
===================================================================
--- set_targ.adb (revision 254563)
+++ set_targ.adb (working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2013-2016, Free Software Foundation, Inc. --
+-- Copyright (C) 2013-2017, 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- --
@@ -580,6 +580,7 @@
-- Checks that we have one or more spaces and skips them
procedure FailN (S : String);
+ pragma No_Return (FailN);
-- Calls Fail adding " name in file xxx", where name is the currently
-- gathered name in Nam_Buf, surrounded by quotes, and xxx is the
-- name of the file.
Index: exp_imgv.adb
===================================================================
--- exp_imgv.adb (revision 254563)
+++ exp_imgv.adb (working copy)
@@ -436,7 +436,7 @@
Imid : RE_Id;
Ptyp : Entity_Id;
Rtyp : Entity_Id;
- Tent : Entity_Id;
+ Tent : Entity_Id := Empty;
Ttyp : Entity_Id;
Proc_Ent : Entity_Id;
Enum_Case : Boolean;
Index: exp_util.adb
===================================================================
--- exp_util.adb (revision 254563)
+++ exp_util.adb (working copy)
@@ -5447,7 +5447,7 @@
(T : Entity_Id;
Iface : Entity_Id) return Entity_Id
is
- AI_Tag : Entity_Id;
+ AI_Tag : Entity_Id := Empty;
Found : Boolean := False;
Typ : Entity_Id := T;
Index: sem_ch6.adb
===================================================================
--- sem_ch6.adb (revision 254563)
+++ sem_ch6.adb (working copy)
@@ -1039,7 +1039,7 @@
---------------------
Expr : Node_Id;
- Obj_Decl : Node_Id;
+ Obj_Decl : Node_Id := Empty;
-- Start of processing for Analyze_Function_Return
@@ -1190,13 +1190,16 @@
-- Case of Expr present
- if Present (Expr)
+ if Present (Expr) then
- -- Defend against previous errors
+ -- Defend against previous errors
- and then Nkind (Expr) /= N_Empty
- and then Present (Etype (Expr))
- then
+ if Nkind (Expr) = N_Empty
+ or else No (Etype (Expr))
+ then
+ return;
+ end if;
+
-- Apply constraint check. Note that this is done before the implicit
-- conversion of the expression done for anonymous access types to
-- ensure correct generation of the null-excluding check associated
Index: sem_res.adb
===================================================================
--- sem_res.adb (revision 254569)
+++ sem_res.adb (working copy)
@@ -1212,7 +1212,7 @@
Func : constant Entity_Id := Entity (Name (N));
Is_Binary : constant Boolean := Present (Act2);
Op_Node : Node_Id;
- Opnd_Type : Entity_Id;
+ Opnd_Type : Entity_Id := Empty;
Orig_Type : Entity_Id := Empty;
Pack : Entity_Id;
@@ -1523,6 +1523,7 @@
-- Operator may be defined in an extension of System
elsif Present (System_Aux_Id)
+ and then Present (Opnd_Type)
and then Scope (Opnd_Type) = System_Aux_Id
then
null;
Index: exp_attr.adb
===================================================================
--- exp_attr.adb (revision 254563)
+++ exp_attr.adb (working copy)
@@ -1054,7 +1054,7 @@
Base_Typ : constant Entity_Id := Base_Type (Etype (Pref));
Exprs : constant List_Id := Expressions (N);
Aux_Decl : Node_Id;
- Blk : Node_Id;
+ Blk : Node_Id := Empty;
Decls : List_Id;
Installed : Boolean;
Loc : Source_Ptr;
Index: exp_ch9.adb
===================================================================
--- exp_ch9.adb (revision 254563)
+++ exp_ch9.adb (working copy)
@@ -6189,8 +6189,7 @@
Cond_Id : Entity_Id;
Entry_Body : Node_Id;
- Func_Body : Node_Id;
- pragma Warnings (Off, Func_Body);
+ Func_Body : Node_Id := Empty;
-- Start of processing for Expand_Entry_Barrier
Index: inline.adb
===================================================================
--- inline.adb (revision 254563)
+++ inline.adb (working copy)
@@ -2224,13 +2224,13 @@
Exit_Lab : Entity_Id := Empty;
F : Entity_Id;
A : Node_Id;
- Lab_Decl : Node_Id;
+ Lab_Decl : Node_Id := Empty;
Lab_Id : Node_Id;
New_A : Node_Id;
- Num_Ret : Nat := 0;
+ Num_Ret : Nat := 0;
Ret_Type : Entity_Id;
- Targ : Node_Id;
+ Targ : Node_Id := Empty;
-- The target of the call. If context is an assignment statement then
-- this is the left-hand side of the assignment, else it is a temporary
-- to which the return value is assigned prior to rewriting the call.
Index: binde.adb
===================================================================
--- binde.adb (revision 254563)
+++ binde.adb (working copy)
@@ -353,6 +353,7 @@
procedure Diagnose_Elaboration_Problem
(Elab_Order : in out Unit_Id_Table);
+ pragma No_Return (Diagnose_Elaboration_Problem);
-- Called when no elaboration order can be found. Outputs an appropriate
-- diagnosis of the problem, and then abandons the bind.
Index: sem_dim.adb
===================================================================
--- sem_dim.adb (revision 254563)
+++ sem_dim.adb (working copy)
@@ -903,13 +903,13 @@
Choice : Node_Id;
Dim_Aggr : Node_Id;
Dim_Symbol : Node_Id;
- Dim_Symbols : Symbol_Array := No_Symbols;
- Dim_System : System_Type := Null_System;
- Position : Nat := 0;
+ Dim_Symbols : Symbol_Array := No_Symbols;
+ Dim_System : System_Type := Null_System;
+ Position : Dimension_Position := Invalid_Position;
Unit_Name : Node_Id;
- Unit_Names : Name_Array := No_Names;
+ Unit_Names : Name_Array := No_Names;
Unit_Symbol : Node_Id;
- Unit_Symbols : Symbol_Array := No_Symbols;
+ Unit_Symbols : Symbol_Array := No_Symbols;
Errors_Count : Nat;
-- Errors_Count is a count of errors detected by the compiler so far
@@ -949,13 +949,13 @@
Dim_Aggr := First (Expressions (Aggr));
Errors_Count := Serious_Errors_Detected;
while Present (Dim_Aggr) loop
- Position := Position + 1;
-
- if Position > High_Position_Bound then
+ if Position = High_Position_Bound then
Error_Msg_N ("too many dimensions in system", Aggr);
exit;
end if;
+ Position := Position + 1;
+
if Nkind (Dim_Aggr) /= N_Aggregate then
Error_Msg_N ("aggregate expected", Dim_Aggr);
Index: sem_ch9.adb
===================================================================
--- sem_ch9.adb (revision 254563)
+++ sem_ch9.adb (working copy)
@@ -2287,7 +2287,7 @@
Target_Obj : Node_Id := Empty;
Req_Scope : Entity_Id;
Outer_Ent : Entity_Id;
- Synch_Type : Entity_Id;
+ Synch_Type : Entity_Id := Empty;
begin
-- Preserve relevant elaboration-related attributes of the context which
@@ -3513,10 +3513,10 @@
-- declarations. Search for the private type declaration.
declare
- Full_T_Ifaces : Elist_Id;
+ Full_T_Ifaces : Elist_Id := No_Elist;
Iface : Node_Id;
Priv_T : Entity_Id;
- Priv_T_Ifaces : Elist_Id;
+ Priv_T_Ifaces : Elist_Id := No_Elist;
begin
Priv_T := First_Entity (Scope (T));
Index: stylesw.adb
===================================================================
--- stylesw.adb (revision 254563)
+++ stylesw.adb (working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2016, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2017, 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- --
@@ -150,10 +150,6 @@
-- Start of processing for Save_Style_Check_Options
begin
- for K in Options'Range loop
- Options (K) := ' ';
- end loop;
-
Add (Character'Val (Style_Check_Indentation + Character'Pos ('0')),
Style_Check_Indentation /= 0);
Index: contracts.adb
===================================================================
--- contracts.adb (revision 254563)
+++ contracts.adb (working copy)
@@ -2393,6 +2393,11 @@
end if;
end Process_Contract_Cases_For;
+ pragma Unmodified (Stmts);
+ -- Stmts is passed as IN OUT to signal that the list can be updated,
+ -- even if the corresponding integer value representing the list does
+ -- not change.
+
-- Start of processing for Process_Contract_Cases
begin
@@ -2535,6 +2540,11 @@
end loop;
end Process_Spec_Postconditions;
+ pragma Unmodified (Stmts);
+ -- Stmts is passed as IN OUT to signal that the list can be updated,
+ -- even if the corresponding integer value representing the list does
+ -- not change.
+
-- Start of processing for Process_Postconditions
begin
Index: exp_ch4.adb
===================================================================
--- exp_ch4.adb (revision 254563)
+++ exp_ch4.adb (working copy)
@@ -2766,7 +2766,7 @@
-- special case of setting the right high bound for a null result.
-- This is of type Ityp.
- High_Bound : Node_Id;
+ High_Bound : Node_Id := Empty;
-- A tree node representing the high bound of the result (of type Ityp)
Result : Node_Id;
@@ -4800,7 +4800,7 @@
declare
Dis : Boolean := False;
- Typ : Entity_Id;
+ Typ : Entity_Id := Empty;
begin
if Has_Discriminants (T) then
@@ -13112,10 +13112,10 @@
Comp : Node_Id;
-- Comparison operand, set only if Is_Zero is false
- Ent : Entity_Id;
+ Ent : Entity_Id := Empty;
-- Entity whose length is being compared
- Index : Node_Id;
+ Index : Node_Id := Empty;
-- Integer_Literal node for length attribute expression, or Empty
-- if there is no such expression present.
Index: sem_warn.adb
===================================================================
--- sem_warn.adb (revision 254563)
+++ sem_warn.adb (working copy)
@@ -3344,7 +3344,8 @@
-----------------------------
procedure Warn_On_Known_Condition (C : Node_Id) is
- Test_Result : Boolean;
+ Test_Result : Boolean := False;
+ -- Force initialization to facilitate static analysis
function Is_Known_Branch return Boolean;
-- If the type of the condition is Boolean, the constant value of the
