+2017-11-09 Yannick Moy <moy@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.
+
+2017-11-09 Eric Botcazou <ebotcazou@adacore.com>
+
+ * exp_ch11.adb (Possible_Local_Raise): Do not issue the warning for
+ generic instantiations either.
+
2017-11-09 Piotr Trojanek <trojanek@adacore.com>
* sem_prag.adb (Analyze_Part_Of): Reword error message.
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.
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
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
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;
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;
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
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
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
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;
-- and the warning is enabled, generate the appropriate warnings.
-- ??? Do not do it for the Call_Marker nodes inserted by the ABE
- -- mechanism because this generates too many false positives.
+ -- mechanism because this generates too many false positives, or
+ -- for generic instantiations for the same reason.
elsif Warn_On_Non_Local_Exception
and then Restriction_Active (No_Exception_Propagation)
and then Nkind (N) /= N_Call_Marker
+ and then Nkind (N) not in N_Generic_Instantiation
then
Warn_No_Exception_Propagation_Active (N);
-- 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;
declare
Dis : Boolean := False;
- Typ : Entity_Id;
+ Typ : Entity_Id := Empty;
begin
if Has_Discriminants (T) then
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.
-- 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
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
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
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;
(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;
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).
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.
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;
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;
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;
--------------------------
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
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;
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
---------------------
Expr : Node_Id;
- Obj_Decl : Node_Id;
+ Obj_Decl : Node_Id := Empty;
-- Start of processing for Analyze_Function_Return
-- Case of Expr present
- if Present (Expr)
+ if Present (Expr) then
- -- Defend against previous errors
+ -- Defend against previous errors
+
+ if Nkind (Expr) = N_Empty
+ or else No (Etype (Expr))
+ then
+ return;
+ end if;
- and then Nkind (Expr) /= N_Empty
- and then Present (Etype (Expr))
- then
-- 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
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
-- 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));
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
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);
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
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;
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;
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;
-- 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;
-- 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
-----------------------------
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
-- --
-- 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- --
-- 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.
-- --
-- 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- --
-- 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);