diff options
| author | Arnaud Charlet <charlet@adacore.com> | 2019-12-12 14:01:03 +0100 |
|---|---|---|
| committer | Pierre-Marie de Rodat <derodat@adacore.com> | 2020-06-02 04:58:05 -0400 |
| commit | a6b13d324fa2d83538e2c733906ced7b000209ac (patch) | |
| tree | da57150775778fc8e4b3770d2b80fd68e49c4c66 /gcc | |
| parent | 5c726f3e42e227fdca32289e99b815988c40481a (diff) | |
| download | gcc-a6b13d324fa2d83538e2c733906ced7b000209ac.zip gcc-a6b13d324fa2d83538e2c733906ced7b000209ac.tar.gz gcc-a6b13d324fa2d83538e2c733906ced7b000209ac.tar.bz2 | |
[Ada] Address potentially uninitialized variables and dead code
2020-06-02 Arnaud Charlet <charlet@adacore.com>
gcc/ada/
* bcheck.adb, binde.adb, bindo-diagnostics.adb, checks.adb,
exp_aggr.adb, exp_ch3.adb, exp_ch4.adb, exp_ch7.adb,
exp_ch9.adb, gnatname.adb, sem_case.adb, sem_ch13.adb,
sem_ch5.adb, sem_prag.adb, sem_util.adb, uintp.adb, urealp.adb,
xoscons.adb, xr_tabls.adb, xref_lib.adb: Initialize objects more
explicitly and add corresponding assertions. Remove dead code.
Also add a few Annotate pragmas to help static analysis.
* libgnat/a-caldel.adb, libgnat/a-calend.adb,
libgnat/a-ngcoty.adb, libgnat/a-ngelfu.adb,
libgnat/a-ngrear.adb, libgnat/a-strfix.adb,
libgnat/g-calend.adb, libgnat/g-catiio.adb,
libgnat/g-comlin.adb, libgnat/g-debpoo.adb,
libgnat/g-dirope.adb, libgnat/g-hesorg.adb,
libgnat/g-pehage.adb, libgnat/g-socket.adb, libgnat/i-cobol.adb,
libgnat/s-dwalin.adb, libgnat/s-dwalin.ads,
libgnat/s-fatgen.adb, libgnat/s-gearop.adb,
libgnat/s-genbig.adb, libgnat/s-imgrea.adb,
libgnat/s-os_lib.adb, libgnat/s-rannum.adb,
libgnat/s-regpat.adb, libgnat/s-trasym__dwarf.adb,
libgnat/s-valrea.adb: Ditto.
Diffstat (limited to 'gcc')
46 files changed, 212 insertions, 100 deletions
diff --git a/gcc/ada/bcheck.adb b/gcc/ada/bcheck.adb index 2324630..55c1eff 100644 --- a/gcc/ada/bcheck.adb +++ b/gcc/ada/bcheck.adb @@ -771,7 +771,7 @@ package body Bcheck is -- Reset when we find a unit that depends on the default and does -- not have a local specification of the Optimize_Alignment setting. - OA_Unit : Unit_Id; + OA_Unit : Unit_Id := No_Unit_Id; -- Id of unit from which OA_Setting was set C : Character; @@ -789,6 +789,7 @@ package body Bcheck is null; else + pragma Assert (Present (OA_Unit)); Error_Msg_Unit_1 := Units.Table (OA_Unit).Uname; Error_Msg_Unit_2 := Units.Table (U).Uname; diff --git a/gcc/ada/binde.adb b/gcc/ada/binde.adb index 5caee49..abf9497 100644 --- a/gcc/ada/binde.adb +++ b/gcc/ada/binde.adb @@ -1056,6 +1056,8 @@ package body Binde is -- becomes zero, then add to no-predecessor list. S := UNR.Table (Chosen).Successors; + pragma Annotate (CodePeer, Modified, S); + while S /= No_Successor loop U := Succ.Table (S).After; UNR.Table (U).Num_Pred := UNR.Table (U).Num_Pred - 1; @@ -2390,6 +2392,8 @@ package body Binde is begin if ST.Reason in Elab_All .. Elab_All_Desirable then L := ST.Elab_All_Link; + pragma Annotate (CodePeer, Modified, L); + while L /= No_Elab_All_Link loop Nam := Elab_All_Entries.Table (L).Needed_By; Error_Msg_Unit_1 := Nam; diff --git a/gcc/ada/bindo-diagnostics.adb b/gcc/ada/bindo-diagnostics.adb index 6f19ac0..934e9a6 100644 --- a/gcc/ada/bindo-diagnostics.adb +++ b/gcc/ada/bindo-diagnostics.adb @@ -343,7 +343,7 @@ package body Bindo.Diagnostics is (G => Lib_Graph, Cycle => Cycle); - Current_Edge : Library_Graph_Edge_Id; + Current_Edge : Library_Graph_Edge_Id := No_Library_Graph_Edge; First_Edge : Library_Graph_Edge_Id; Iter : Edges_Of_Cycle_Iterator; Next_Edge : Library_Graph_Edge_Id; diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 51ef6c0..6c59764 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -8740,8 +8740,7 @@ package body Checks is else declare - Rtype : Entity_Id; - pragma Warnings (Off, Rtype); + Rtype : Entity_Id := Empty; New_Alts : List_Id; New_Exp : Node_Id; @@ -8771,6 +8770,7 @@ package body Checks is Expression => Expression (N), Alternatives => New_Alts)); + pragma Assert (Present (Rtype)); Reanalyze (Rtype, Suppress => True); end; end if; diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 60ad4d6..f4b9595 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -5239,7 +5239,7 @@ package body Exp_Aggr is -- specifically optimized for the target. function Aggr_Assignment_OK_For_Backend (N : Node_Id) return Boolean is - Csiz : Uint; + Csiz : Uint := No_Uint; Ctyp : Entity_Id; Expr : Node_Id; High : Node_Id; @@ -5336,6 +5336,8 @@ package body Exp_Aggr is -- Scalar types are OK if their size is a multiple of Storage_Unit elsif Is_Scalar_Type (Ctyp) then + pragma Assert (Csiz /= No_Uint); + if Csiz mod System_Storage_Unit /= 0 then return False; end if; diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 82a58b7..15d468b 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -5579,7 +5579,7 @@ package body Exp_Ch3 is declare Comp : Entity_Id; First : Boolean; - M_Id : Entity_Id; + M_Id : Entity_Id := Empty; Typ : Entity_Id; begin @@ -5612,6 +5612,7 @@ package body Exp_Ch3 is -- Reuse the same master to service any additional types else + pragma Assert (Present (M_Id)); Set_Master_Id (Typ, M_Id); end if; end if; diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 28d48ab..7785776 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -2814,7 +2814,7 @@ package body Exp_Ch4 is -- to just do a Copy_Node to get an appropriate copy. The extra zeroth -- entry always is set to zero. The length is of type Artyp. - Low_Bound : Node_Id; + Low_Bound : Node_Id := Empty; -- A tree node representing the low bound of the result (of type Ityp). -- This is either an integer literal node, or an identifier reference to -- a constant entity initialized to the appropriate value. @@ -2834,7 +2834,7 @@ package body Exp_Ch4 is High_Bound : Node_Id := Empty; -- A tree node representing the high bound of the result (of type Ityp) - Result : Node_Id; + Result : Node_Id := Empty; -- Result of the concatenation (of type Ityp) Actions : constant List_Id := New_List; @@ -3365,6 +3365,8 @@ package body Exp_Ch4 is end; end if; + pragma Assert (Present (Low_Bound)); + -- Now we can safely compute the upper bound, normally -- Low_Bound + Length - 1. @@ -3621,6 +3623,7 @@ package body Exp_Ch4 is Result := New_Occurrence_Of (Ent, Loc); <<Done>> + pragma Assert (Present (Result)); Rewrite (Cnode, Result); Analyze_And_Resolve (Cnode, Atyp); @@ -4369,8 +4372,7 @@ package body Exp_Ch4 is declare Idx : Node_Id := First_Index (E); Len : Node_Id; - Res : Node_Id; - pragma Warnings (Off, Res); + Res : Node_Id := Empty; begin for J in 1 .. Number_Dimensions (E) loop @@ -4443,6 +4445,7 @@ package body Exp_Ch4 is Res := Len; else + pragma Assert (Present (Res)); Res := Make_Op_Multiply (Loc, Left_Opnd => Res, diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 125eba6..d4c8b99 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -909,7 +909,7 @@ package body Exp_Ch7 is elsif Is_Protected_Body then declare Spec : constant Node_Id := Parent (Corresponding_Spec (N)); - Conc_Typ : Entity_Id; + Conc_Typ : Entity_Id := Empty; Param : Node_Id; Param_Typ : Entity_Id; @@ -929,6 +929,7 @@ package body Exp_Ch7 is end loop; pragma Assert (Present (Param)); + pragma Assert (Present (Conc_Typ)); -- Historical note: In earlier versions of GNAT, there was code -- at this point to generate stuff to service entry queues. It is @@ -5720,8 +5721,8 @@ package body Exp_Ch7 is Blk_Decl : Node_Id := Empty; Blk_Decls : List_Id := No_List; Blk_Ins : Node_Id; - Blk_Stmts : List_Id; - Loc : Source_Ptr; + Blk_Stmts : List_Id := No_List; + Loc : Source_Ptr := No_Location; Obj_Decl : Node_Id; -- Start of processing for Process_Transients_In_Scope @@ -5854,6 +5855,7 @@ package body Exp_Ch7 is -- Construct all necessary circuitry to hook and finalize a -- single transient object. + pragma Assert (Present (Blk_Stmts)); Process_Transient_In_Scope (Obj_Decl => Obj_Decl, Blk_Data => Blk_Data, @@ -5875,6 +5877,9 @@ package body Exp_Ch7 is if Present (Blk_Decl) then + pragma Assert (Present (Blk_Stmts)); + pragma Assert (Loc /= No_Location); + -- Note that this Abort_Undefer does not require a extra block or -- an AT_END handler because each finalization exception is caught -- in its own corresponding finalization block. As a result, the diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index 392a221..a2afa2e 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -2546,7 +2546,7 @@ package body Exp_Ch9 is Lo : Node_Id; Hi : Node_Id; Decls : List_Id := New_List; - Ret : Node_Id; + Ret : Node_Id := Empty; Spec : Node_Id; Siz : Node_Id := Empty; @@ -2692,16 +2692,21 @@ package body Exp_Ch9 is Make_Simple_Return_Statement (Loc, Expression => Make_Integer_Literal (Loc, 1)); - elsif Nkind (Ret) = N_If_Statement then + else + pragma Assert (Present (Ret)); - -- Ranges are in increasing order, so last one doesn't need guard + if Nkind (Ret) = N_If_Statement then - declare - Nod : constant Node_Id := Last (Elsif_Parts (Ret)); - begin - Remove (Nod); - Set_Else_Statements (Ret, Then_Statements (Nod)); - end; + -- Ranges are in increasing order, so last one doesn't need + -- guard. + + declare + Nod : constant Node_Id := Last (Elsif_Parts (Ret)); + begin + Remove (Nod); + Set_Else_Statements (Ret, Then_Statements (Nod)); + end; + end if; end if; end if; @@ -10209,8 +10214,7 @@ package body Exp_Ch9 is declare Elmt : Elmt_Id; - Op : Entity_Id; - pragma Warnings (Off, Op); + Op : Entity_Id := Empty; begin Elmt := First_Elmt (Primitive_Operations (Etype (Conc_Typ))); @@ -10220,6 +10224,8 @@ package body Exp_Ch9 is Next_Elmt (Elmt); end loop; + pragma Assert (Present (Op)); + return Make_Procedure_Call_Statement (Loc, Name => New_Occurrence_Of (Op, Loc), @@ -10630,7 +10636,7 @@ package body Exp_Ch9 is Num_Alts : Nat; Num_Accept : Nat := 0; Proc : Node_Id; - Time_Type : Entity_Id; + Time_Type : Entity_Id := Empty; Select_Call : Node_Id; Qnam : constant Entity_Id := @@ -11251,6 +11257,8 @@ package body Exp_Ch9 is Delay_Min := Make_Defining_Identifier (Loc, New_External_Name ('D', 3)); + pragma Assert (Present (Time_Type)); + Append_To (Decls, Make_Object_Declaration (Loc, Defining_Identifier => Delay_Val, diff --git a/gcc/ada/gnatname.adb b/gcc/ada/gnatname.adb index cefc276..4d500ce 100644 --- a/gcc/ada/gnatname.adb +++ b/gcc/ada/gnatname.adb @@ -681,6 +681,8 @@ procedure Gnatname is Sources.Last loop Current_Source := Sources.Table (Index); + pragma Annotate + (CodePeer, Modified, Current_Source); if Opt.Verbose_Mode then if Current_Source.Spec then diff --git a/gcc/ada/libgnat/a-caldel.adb b/gcc/ada/libgnat/a-caldel.adb index b7cfefc..9244425 100644 --- a/gcc/ada/libgnat/a-caldel.adb +++ b/gcc/ada/libgnat/a-caldel.adb @@ -103,6 +103,8 @@ begin -- this soft link, or this will be overridden during the elaboration of -- System.Tasking.Initialization + pragma Annotate (CodePeer, Modified, SSL.Timed_Delay); + if SSL.Timed_Delay = null then SSL.Timed_Delay := Timed_Delay_NT'Access; end if; diff --git a/gcc/ada/libgnat/a-calend.adb b/gcc/ada/libgnat/a-calend.adb index 4cbfeff..219fd9a 100644 --- a/gcc/ada/libgnat/a-calend.adb +++ b/gcc/ada/libgnat/a-calend.adb @@ -435,18 +435,14 @@ is if End_T < Leap_Second_Times (1) then Elapsed_Leaps := 0; Next_Leap := Leap_Second_Times (1); - return; elsif Start_T > Leap_Second_Times (Leap_Seconds_Count) then Elapsed_Leaps := 0; Next_Leap := End_Of_Time; - return; - end if; - - -- Perform the calculations only if the start date is within the leap - -- second occurrences table. - if Start_T <= Leap_Second_Times (Leap_Seconds_Count) then + else + -- Perform the calculations only if the start date is within the leap + -- second occurrences table. -- 1 2 N - 1 N -- +----+----+-- . . . --+-------+---+ @@ -480,9 +476,6 @@ is end if; Elapsed_Leaps := End_Index - Start_Index; - - else - Elapsed_Leaps := 0; end if; end Cumulative_Leap_Seconds; @@ -763,6 +756,7 @@ is (Secs_T'Unchecked_Access, Flag'Unchecked_Access, Offset'Unchecked_Access); + pragma Annotate (CodePeer, Modified, Offset); return Long_Integer (Offset); end UTC_Time_Offset; diff --git a/gcc/ada/libgnat/a-ngcoty.adb b/gcc/ada/libgnat/a-ngcoty.adb index bece703..deb200b 100644 --- a/gcc/ada/libgnat/a-ngcoty.adb +++ b/gcc/ada/libgnat/a-ngcoty.adb @@ -66,11 +66,19 @@ package body Ada.Numerics.Generic_Complex_Types is -- return false, the test can only be written thus. if not (abs (X) <= R'Last) then + pragma Annotate + (CodePeer, Intentional, + "test always false", "test for infinity"); + X := Scale**2 * ((Left.Re / Scale) * (Right.Re / Scale) - (Left.Im / Scale) * (Right.Im / Scale)); end if; if not (abs (Y) <= R'Last) then + pragma Annotate + (CodePeer, Intentional, + "test always false", "test for infinity"); + Y := Scale**2 * ((Left.Re / Scale) * (Right.Im / Scale) + (Left.Im / Scale) * (Right.Re / Scale)); end if; @@ -588,6 +596,7 @@ package body Ada.Numerics.Generic_Complex_Types is exception when Constraint_Error => + pragma Assert (X.Re /= 0.0); return R (Double (abs (X.Re)) * Sqrt (1.0 + (Double (X.Im) / Double (X.Re)) ** 2)); end; @@ -602,6 +611,7 @@ package body Ada.Numerics.Generic_Complex_Types is exception when Constraint_Error => + pragma Assert (X.Im /= 0.0); return R (Double (abs (X.Im)) * Sqrt (1.0 + (Double (X.Re) / Double (X.Im)) ** 2)); end; diff --git a/gcc/ada/libgnat/a-ngelfu.adb b/gcc/ada/libgnat/a-ngelfu.adb index 71cd47b..3d49404 100644 --- a/gcc/ada/libgnat/a-ngelfu.adb +++ b/gcc/ada/libgnat/a-ngelfu.adb @@ -680,6 +680,8 @@ is Z := G * G; P := G * ((P2 * Z + P1) * Z + P0); Q := ((Q3 * Z + Q2) * Z + Q1) * Z + Q0; + + pragma Assert (Q /= P); R := 0.5 + P / (Q - P); R := Float_Type'Base'Scaling (R, Integer (XN) + 1); diff --git a/gcc/ada/libgnat/a-ngrear.adb b/gcc/ada/libgnat/a-ngrear.adb index 8418ec1..8348cb7 100644 --- a/gcc/ada/libgnat/a-ngrear.adb +++ b/gcc/ada/libgnat/a-ngrear.adb @@ -560,6 +560,8 @@ package body Ada.Numerics.Generic_Real_Arrays is function Compute_Tan (P, H : Real) return Real is (if Is_Tiny (P, Compared_To => H) then P / H else Compute_Tan (Theta => H / (2.0 * P))); + pragma Annotate + (CodePeer, False_Positive, "divide by zero", "H, P /= 0"); function Sum_Strict_Upper (M : Square_Matrix) return Real; -- Return the sum of all elements in the strict upper triangle of M diff --git a/gcc/ada/libgnat/a-strfix.adb b/gcc/ada/libgnat/a-strfix.adb index b8b5f42..1f94b86 100644 --- a/gcc/ada/libgnat/a-strfix.adb +++ b/gcc/ada/libgnat/a-strfix.adb @@ -192,6 +192,10 @@ package body Ada.Strings.Fixed is elsif From not in Source'Range or else Through > Source'Last then + pragma Annotate + (CodePeer, False_Positive, + "test always false", "self fullfilling prophecy"); + -- In most cases this raises an exception, but the case of deleting -- a null string at the end of the current one is a special-case, and -- reflects the equivalence with Replace_String (RM A.4.3 (86/3)). diff --git a/gcc/ada/libgnat/g-calend.adb b/gcc/ada/libgnat/g-calend.adb index d1d4b55..ab5bab3 100644 --- a/gcc/ada/libgnat/g-calend.adb +++ b/gcc/ada/libgnat/g-calend.adb @@ -352,6 +352,9 @@ package body GNAT.Calendar is begin timeval_to_duration (T, sec'Access, usec'Access); + pragma Annotate (CodePeer, Modified, sec); + pragma Annotate (CodePeer, Modified, usec); + return Duration (sec) + Duration (usec) / Micro; end To_Duration; diff --git a/gcc/ada/libgnat/g-catiio.adb b/gcc/ada/libgnat/g-catiio.adb index dc2fa40..cc860ab 100644 --- a/gcc/ada/libgnat/g-catiio.adb +++ b/gcc/ada/libgnat/g-catiio.adb @@ -950,6 +950,8 @@ package body GNAT.Calendar.Time_IO is when End_Of_Source_Reached | Wrong_Syntax => + Time := + Time_Of (Year_Number'First, Month_Number'First, Day_Number'First); Success := False; end Parse_ISO_8861_UTC; diff --git a/gcc/ada/libgnat/g-comlin.adb b/gcc/ada/libgnat/g-comlin.adb index ec057a9..bb553e9 100644 --- a/gcc/ada/libgnat/g-comlin.adb +++ b/gcc/ada/libgnat/g-comlin.adb @@ -537,6 +537,7 @@ package body GNAT.Command_Line is P : Switch_Parameter_Type; begin + Param := Parameter_None; Index_In_Switches := 0; Switch_Length := 0; diff --git a/gcc/ada/libgnat/g-debpoo.adb b/gcc/ada/libgnat/g-debpoo.adb index 52c0c50..ae2fb1c 100644 --- a/gcc/ada/libgnat/g-debpoo.adb +++ b/gcc/ada/libgnat/g-debpoo.adb @@ -1420,6 +1420,7 @@ package body GNAT.Debug_Pools is begin Valid := Is_Valid (Storage_Address); + Size_In_Storage_Elements := Storage_Count'First; if Is_Valid (Storage_Address) then declare diff --git a/gcc/ada/libgnat/g-dirope.adb b/gcc/ada/libgnat/g-dirope.adb index 9153c70..0fd7a24 100644 --- a/gcc/ada/libgnat/g-dirope.adb +++ b/gcc/ada/libgnat/g-dirope.adb @@ -352,6 +352,8 @@ package body GNAT.Directory_Operations is begin K := K + 1; + pragma Annotate (CodePeer, Modified, P); + if P = '%' or else Path (K) = '{' then -- Set terminator character diff --git a/gcc/ada/libgnat/g-hesorg.adb b/gcc/ada/libgnat/g-hesorg.adb index fec6e9c..bf54874 100644 --- a/gcc/ada/libgnat/g-hesorg.adb +++ b/gcc/ada/libgnat/g-hesorg.adb @@ -45,6 +45,8 @@ package body GNAT.Heap_Sort_G is -- from 2NlogN to NlogN. procedure Sort (N : Natural) is + pragma Annotate (CodePeer, Skip_Analysis); + -- CodePeer is sometimes getting confused on this procedure Max : Natural := N; -- Current Max index in tree being sifted diff --git a/gcc/ada/libgnat/g-pehage.adb b/gcc/ada/libgnat/g-pehage.adb index 9b88256..a65dc85 100644 --- a/gcc/ada/libgnat/g-pehage.adb +++ b/gcc/ada/libgnat/g-pehage.adb @@ -622,6 +622,7 @@ package body GNAT.Perfect_Hash_Generators is E := Get_Edges (J); if Get_Graph (E.Y) = -1 then + pragma Assert (NK /= 0); Set_Graph (E.Y, (E.Key - Get_Graph (X)) mod NK); Assign (E.Y); end if; @@ -2201,6 +2202,8 @@ package body GNAT.Perfect_Hash_Generators is -- in the position selection. for J in S'Range loop + pragma Annotate (CodePeer, Modified, S (J)); + if S (J).First = S (J).Last then F := S (J).First; L := S (J).Last; @@ -2359,6 +2362,10 @@ package body GNAT.Perfect_Hash_Generators is for P in 1 .. Last_Sel_Pos - 1 loop if Max_Diff_Sel_Pos < Sel_Position (P) then + pragma Annotate + (CodePeer, False_Positive, + "test always false", "false positive?"); + Sel_Position (P + 1 .. Last_Sel_Pos) := Sel_Position (P .. Last_Sel_Pos - 1); Sel_Position (P) := Max_Diff_Sel_Pos; @@ -2525,6 +2532,7 @@ package body GNAT.Perfect_Hash_Generators is for J in 0 .. T1_Len - 1 loop exit when Word (J + 1) = ASCII.NUL; R := Get_Table (Table, J, Get_Used_Char (Word (J + 1))); + pragma Assert (NV /= 0); S := (S + R) mod NV; end loop; @@ -2532,6 +2540,7 @@ package body GNAT.Perfect_Hash_Generators is for J in 0 .. T1_Len - 1 loop exit when Word (J + 1) = ASCII.NUL; R := Get_Table (Table, J, 0); + pragma Assert (NV /= 0); S := (S + R * Character'Pos (Word (J + 1))) mod NV; end loop; end case; diff --git a/gcc/ada/libgnat/g-socket.adb b/gcc/ada/libgnat/g-socket.adb index 6c65424..8f8c9d81 100644 --- a/gcc/ada/libgnat/g-socket.adb +++ b/gcc/ada/libgnat/g-socket.adb @@ -836,6 +836,7 @@ package body GNAT.Sockets is -- the waiting task to resume its execution. Res := Signalling_Fds.Create (Two_Fds'Access); + pragma Annotate (CodePeer, Modified, Two_Fds); if Res = Failure then Raise_Socket_Error (Socket_Errno); @@ -886,6 +887,7 @@ package body GNAT.Sockets is ((if Family = Family_Unspec then Default_Socket_Pair_Family else Families (Family)), Modes (Mode), Levels (Level), Pair'Access); + pragma Annotate (CodePeer, Modified, Pair); if Res = Failure then Raise_Socket_Error (Socket_Errno); @@ -957,8 +959,12 @@ package body GNAT.Sockets is if Item.Last /= No_Socket then Get_Socket_From_Set (Item.Set'Access, Last => L'Access, Socket => S'Access); + pragma Annotate (CodePeer, Modified, L); + pragma Annotate (CodePeer, Modified, S); + Item.Last := Socket_Type (L); Socket := Socket_Type (S); + else Socket := No_Socket; end if; @@ -2921,8 +2927,7 @@ package body GNAT.Sockets is -- To_Int -- ------------ - function To_Int (F : Request_Flag_Type) return C.int - is + function To_Int (F : Request_Flag_Type) return C.int is Current : Request_Flag_Type := F; Result : C.int := 0; @@ -2932,6 +2937,10 @@ package body GNAT.Sockets is if Current mod 2 /= 0 then if Flags (J) = -1 then + pragma Annotate + (CodePeer, False_Positive, + "test always false", "self fulfilling prophecy"); + Raise_Socket_Error (SOSC.EOPNOTSUPP); end if; diff --git a/gcc/ada/libgnat/i-cobol.adb b/gcc/ada/libgnat/i-cobol.adb index 807a3a1..6caa351 100644 --- a/gcc/ada/libgnat/i-cobol.adb +++ b/gcc/ada/libgnat/i-cobol.adb @@ -240,11 +240,6 @@ package body Interfaces.COBOL is (COBOL_Character'Pos (K) - COBOL_Character'Pos (COBOL_Digits'First)); - elsif K in COBOL_Plus_Digits then - Result := Result * 10 + - (COBOL_Character'Pos (K) - - COBOL_Character'Pos (COBOL_Plus_Digits'First)); - elsif K in COBOL_Minus_Digits then Result := Result * 10 + (COBOL_Character'Pos (K) - diff --git a/gcc/ada/libgnat/s-dwalin.adb b/gcc/ada/libgnat/s-dwalin.adb index 5307eae..6745953 100644 --- a/gcc/ada/libgnat/s-dwalin.adb +++ b/gcc/ada/libgnat/s-dwalin.adb @@ -440,6 +440,10 @@ package body System.Dwarf_Lines is or else Info_Sec = Null_Section or else Aranges_Sec = Null_Section then + pragma Annotate + (CodePeer, False_Positive, + "test always true", "codepeer got confused"); + C.Has_Debug := False; return; end if; @@ -883,6 +887,7 @@ package body System.Dwarf_Lines is Success : out Boolean) is begin + Info_Offset := 0; Seek (C.Aranges, 0); while Tell (C.Aranges) < Length (C.Aranges) loop @@ -905,6 +910,7 @@ package body System.Dwarf_Lines is end; end loop; end loop; + Success := False; end Aranges_Lookup; @@ -1028,6 +1034,7 @@ package body System.Dwarf_Lines is Has_Child : uint8; pragma Unreferenced (Has_Child); begin + Line_Offset := 0; Success := False; Seek (C.Info, Info_Offset); @@ -1119,7 +1126,8 @@ package body System.Dwarf_Lines is Version : uint16; Sz : uint8; begin - Success := False; + Success := False; + Info_Offset := 0; Read_Initial_Length (C.Aranges, Unit_Length, Is64); @@ -1407,6 +1415,7 @@ package body System.Dwarf_Lines is Success : Boolean; Done : Boolean; S : Object_Symbol; + begin -- Initialize result Dir_Name := null; @@ -1422,6 +1431,8 @@ package body System.Dwarf_Lines is begin First := C.Cache'First; Last := C.Cache'Last; + Mid := First; + while First <= Last loop Mid := First + (Last - First) / 2; if Addr_Off < C.Cache (Mid).First then @@ -1432,6 +1443,7 @@ package body System.Dwarf_Lines is exit; end if; end loop; + if Addr_Off >= C.Cache (Mid).First and then Addr_Off < C.Cache (Mid).First + C.Cache (Mid).Size then @@ -1474,6 +1486,7 @@ package body System.Dwarf_Lines is C.Next_Prologue := 0; Initialize_State_Machine (C); Parse_Prologue (C); + Previous_Row.Line := 0; -- Advance to the first entry @@ -1535,7 +1548,7 @@ package body System.Dwarf_Lines is (Cin : Dwarf_Context; Traceback : AET.Tracebacks_Array; Suppress_Hex : Boolean; - Symbol_Found : in out Boolean; + Symbol_Found : out Boolean; Res : in out System.Bounded_Strings.Bounded_String) is use Ada.Characters.Handling; diff --git a/gcc/ada/libgnat/s-dwalin.ads b/gcc/ada/libgnat/s-dwalin.ads index 297fd8e..cfde1c6 100644 --- a/gcc/ada/libgnat/s-dwalin.ads +++ b/gcc/ada/libgnat/s-dwalin.ads @@ -93,7 +93,7 @@ package System.Dwarf_Lines is (Cin : Dwarf_Context; Traceback : AET.Tracebacks_Array; Suppress_Hex : Boolean; - Symbol_Found : in out Boolean; + Symbol_Found : out Boolean; Res : in out System.Bounded_Strings.Bounded_String); -- Generate a string for a traceback suitable for displaying to the user. -- If one or more symbols are found, Symbol_Found is set to True. This diff --git a/gcc/ada/libgnat/s-fatgen.adb b/gcc/ada/libgnat/s-fatgen.adb index 93237fb..481d672 100644 --- a/gcc/ada/libgnat/s-fatgen.adb +++ b/gcc/ada/libgnat/s-fatgen.adb @@ -219,6 +219,10 @@ package body System.Fat_Gen is Ax := Ax * R_Power (Expbits'Last); Ex := Ex - Log_Power (Expbits'Last); end loop; + pragma Annotate + (CodePeer, Intentional, + "test always false", + "expected for some instantiations"); -- Rad ** -64 <= Ax < 1 diff --git a/gcc/ada/libgnat/s-gearop.adb b/gcc/ada/libgnat/s-gearop.adb index 4064571..166b04b 100644 --- a/gcc/ada/libgnat/s-gearop.adb +++ b/gcc/ada/libgnat/s-gearop.adb @@ -240,6 +240,8 @@ package body System.Generic_Array_Operations is for J in N'Range (2) loop N (Row - M'First (1) + N'First (1), J) := N (Row - M'First (1) + N'First (1), J) / Scale; + pragma Annotate + (CodePeer, False_Positive, "divide by zero", "Scale /= 0"); end loop; end Divide_Row; @@ -602,6 +604,9 @@ package body System.Generic_Array_Operations is end if; elsif X > Real'Base'Last then + pragma Annotate + (CodePeer, Intentional, + "test always false", "test for infinity"); -- X is infinity, which is its own square root @@ -627,6 +632,8 @@ package body System.Generic_Array_Operations is -- of precision. for J in 1 .. 8 loop + pragma Assert (Root /= 0.0); + Next := (Root + X / Root) / 2.0; exit when Root = Next; Root := Next; diff --git a/gcc/ada/libgnat/s-genbig.adb b/gcc/ada/libgnat/s-genbig.adb index 0a92dfb..69d284f 100644 --- a/gcc/ada/libgnat/s-genbig.adb +++ b/gcc/ada/libgnat/s-genbig.adb @@ -733,6 +733,7 @@ package body System.Generic_Bignums is ND := 0; for J in 1 .. X.Len loop ND := Base * ND + DD (X.D (J)); + pragma Assert (Div /= 0); Result (J) := SD (ND / Div); ND := ND rem Div; end loop; diff --git a/gcc/ada/libgnat/s-imgrea.adb b/gcc/ada/libgnat/s-imgrea.adb index 467c482..46cacd0 100644 --- a/gcc/ada/libgnat/s-imgrea.adb +++ b/gcc/ada/libgnat/s-imgrea.adb @@ -289,6 +289,8 @@ package body System.Img_Real is -- What we are looking for is a power of ten to divide X by -- so that the result lies within the required range. + pragma Assert (Powten (Maxpow) /= 0.0); + loop XP := X / Powten (Maxpow); exit when XP < Powten (S) or else Scale > Maxscaling; @@ -490,6 +492,9 @@ package body System.Img_Real is -- an infinite value, so we print Inf. if V > Long_Long_Float'Last then + pragma Annotate + (CodePeer, Intentional, "test always true", "test for infinity"); + Set ('+'); Set ('I'); Set ('n'); diff --git a/gcc/ada/libgnat/s-os_lib.adb b/gcc/ada/libgnat/s-os_lib.adb index 258cd64..28fbbf3 100644 --- a/gcc/ada/libgnat/s-os_lib.adb +++ b/gcc/ada/libgnat/s-os_lib.adb @@ -574,14 +574,15 @@ package body System.OS_Lib is -- touch destination file at all. From := Open_Read (Name, Binary); - if From /= Invalid_FD then + + if From = Invalid_FD then + Success := False; + else To := Open_Read_Write (Pathname, Binary); + Lseek (To, 0, Seek_End); + Copy (From, To); end if; - Lseek (To, 0, Seek_End); - - Copy (From, To); - -- Appending to directory, not allowed elsif Is_Directory (Pathname) then @@ -1999,6 +2000,8 @@ package body System.OS_Lib is -- If the string ends with \, double it + pragma Annotate (CodePeer, Modified, Res (J - 1)); + if Res (J - 1) = '\' then Res (J) := '\'; J := J + 1; diff --git a/gcc/ada/libgnat/s-rannum.adb b/gcc/ada/libgnat/s-rannum.adb index 0590313..1aa755c 100644 --- a/gcc/ada/libgnat/s-rannum.adb +++ b/gcc/ada/libgnat/s-rannum.adb @@ -295,6 +295,7 @@ is K : Bit_Count; -- Next decrement to exponent begin + K := 0; Mantissa := Random (Gen) / 2**Extra_Bits; R := Unsigned_32 (Mantissa mod 2**Extra_Bits); R_Bits := Extra_Bits; diff --git a/gcc/ada/libgnat/s-regpat.adb b/gcc/ada/libgnat/s-regpat.adb index ae69f47..69fe150 100644 --- a/gcc/ada/libgnat/s-regpat.adb +++ b/gcc/ada/libgnat/s-regpat.adb @@ -1460,19 +1460,9 @@ package body System.Regpat is and then Expression (Parse_Pos + 1) /= ']' then Parse_Pos := Parse_Pos + 1; - - -- Do we have a range like '\d-a' and '[:space:]-a' - -- which is not a real range - - if Named_Class /= ANYOF_NONE then - Set_In_Class (Bitmap, '-'); - else - In_Range := True; - end if; - + In_Range := True; else Set_In_Class (Bitmap, Value); - end if; -- Else in a character range @@ -3275,13 +3265,13 @@ package body System.Regpat is (IP : Pointer; Max : Natural := Natural'Last) return Natural is - Scan : Natural := Input_Pos; - Last : Natural; - Op : constant Opcode := Opcode'Val (Character'Pos (Program (IP))); - Count : Natural; - C : Character; - Is_First : Boolean := True; - Bitmap : Character_Class; + Scan : Natural := Input_Pos; + Last : Natural; + Op : constant Opcode := + Opcode'Val (Character'Pos (Program (IP))); + Count : Natural; + C : Character; + Bitmap : Character_Class; begin if Max = Natural'Last or else Scan + Max - 1 > Last_In_Data then @@ -3324,10 +3314,7 @@ package body System.Regpat is end loop; when ANYOF => - if Is_First then - Bitmap_Operand (Program, IP, Bitmap); - Is_First := False; - end if; + Bitmap_Operand (Program, IP, Bitmap); while Scan <= Last and then Get_From_Class (Bitmap, Data (Scan)) diff --git a/gcc/ada/libgnat/s-trasym__dwarf.adb b/gcc/ada/libgnat/s-trasym__dwarf.adb index b116a10..9f96275 100644 --- a/gcc/ada/libgnat/s-trasym__dwarf.adb +++ b/gcc/ada/libgnat/s-trasym__dwarf.adb @@ -438,7 +438,7 @@ package body System.Traceback.Symbolic is Suppress_Hex : Boolean; Res : in out Bounded_String) is - Success : Boolean := False; + Success : Boolean; begin if Symbolic.Module_Name.Is_Supported then Append (Res, '['); diff --git a/gcc/ada/libgnat/s-valrea.adb b/gcc/ada/libgnat/s-valrea.adb index 424ccd0..2ecc99b 100644 --- a/gcc/ada/libgnat/s-valrea.adb +++ b/gcc/ada/libgnat/s-valrea.adb @@ -92,8 +92,7 @@ package body System.Val_Real is -- As_Digit -- -------------- - function As_Digit (C : Character) return Char_As_Digit - is + function As_Digit (C : Character) return Char_As_Digit is begin case C is when '0' .. '9' => @@ -133,7 +132,9 @@ package body System.Val_Real is Trailing_Zeros : Natural := 0; -- Number of trailing zeros at a given point. + begin + pragma Assert (Base in 2 .. 16); -- If initial Scale is not 0 then it means that Precision_Limit was -- reached during integral part scanning. @@ -217,7 +218,6 @@ package body System.Val_Real is end if; end if; end loop; - end Scan_Decimal_Digits; -------------------------- @@ -268,6 +268,8 @@ package body System.Val_Real is -- Precision limit has been reached so just update the exponent Scale := Scale + 1; else + pragma Assert (Base /= 0); + if Value > (Precision_Limit - Digit) / Base then -- Updating Value will overflow so ignore this digit and any -- following ones. Only update the scale @@ -369,6 +371,10 @@ package body System.Val_Real is -- First character can be either a decimal digit or a dot. if Str (Index) in '0' .. '9' then + pragma Annotate + (CodePeer, Intentional, + "test always true", "defensive code below"); + -- If this is a digit it can indicates either the float decimal -- part or the base to use Scan_Integral_Digits diff --git a/gcc/ada/sem_case.adb b/gcc/ada/sem_case.adb index 8617ea7..5536e6d 100644 --- a/gcc/ada/sem_case.adb +++ b/gcc/ada/sem_case.adb @@ -458,8 +458,7 @@ package body Sem_Case is Choice : Node_Id; Choice_Hi : Uint; Choice_Lo : Uint; - Prev_Choice : Node_Id; - pragma Warnings (Off, Prev_Choice); + Prev_Choice : Node_Id := Empty; Prev_Hi : Uint; begin @@ -485,6 +484,8 @@ package body Sem_Case is end if; end loop; + pragma Assert (Present (Prev_Choice)); + if Sloc (Prev_Choice) <= Sloc (Choice) then Error_Msg_Sloc := Sloc (Prev_Choice); Dup_Choice (Choice_Lo, UI_Min (Choice_Hi, Prev_Hi), Choice); diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 6287434..3894393 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -1580,7 +1580,7 @@ package body Sem_Ch13 is -- Local variables Aspect : Node_Id; - Aitem : Node_Id; + Aitem : Node_Id := Empty; Ent : Node_Id; L : constant List_Id := Aspect_Specifications (N); @@ -10136,8 +10136,8 @@ package body Sem_Ch13 is Rectype : Entity_Id; Fent : Entity_Id; CC : Node_Id; - Fbit : Uint; - Lbit : Uint; + Fbit : Uint := No_Uint; + Lbit : Uint := No_Uint; Hbit : Uint := Uint_0; Comp : Entity_Id; Pcomp : Entity_Id; @@ -10485,6 +10485,7 @@ package body Sem_Ch13 is Nbit := Sbit; for J in 1 .. Ncomps loop CEnt := Comps (J); + pragma Annotate (CodePeer, Modified, CEnt); declare CBO : constant Uint := Component_Bit_Offset (CEnt); diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 2342c54..3f859c2 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -1847,7 +1847,7 @@ package body Sem_Ch5 is Save_Unblocked_Exit_Count : constant Nat := Unblocked_Exit_Count; -- Recursively save value of this global, will be restored on exit - Save_In_Deleted_Code : Boolean; + Save_In_Deleted_Code : Boolean := In_Deleted_Code; Del : Boolean := False; -- This flag gets set True if a True condition has been found, which diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 77cd051..7aa48b5 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -30079,7 +30079,7 @@ package body Sem_Prag is -- explicit contract. Prags : constant Node_Id := Contract (Parent_Subp); - In_Spec_Expr : Boolean; + In_Spec_Expr : Boolean := In_Spec_Expression; Installed : Boolean; Prag : Node_Id; New_Prag : Node_Id; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index c1b1d9e..814d503 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -2759,7 +2759,7 @@ package body Sem_Util is declare Count_Components : Uint := Uint_0; Num_Components : Uint; - Others_Assoc : Node_Id; + Others_Assoc : Node_Id := Empty; Others_Choice : Node_Id := Empty; Others_Box_Present : Boolean := False; @@ -2844,6 +2844,8 @@ package body Sem_Util is -- minimum decoration required to collect the -- identifiers. + pragma Assert (Present (Others_Assoc)); + if not Expander_Active then Comp_Expr := Expression (Others_Assoc); else @@ -13269,7 +13271,7 @@ package body Sem_Util is procedure Insert_Explicit_Dereference (N : Node_Id) is New_Prefix : constant Node_Id := Relocate_Node (N); Ent : Entity_Id := Empty; - Pref : Node_Id; + Pref : Node_Id := Empty; I : Interp_Index; It : Interp; T : Entity_Id; diff --git a/gcc/ada/uintp.adb b/gcc/ada/uintp.adb index 61e9f3d..bfdcb29 100644 --- a/gcc/ada/uintp.adb +++ b/gcc/ada/uintp.adb @@ -1294,6 +1294,7 @@ package body Uintp is Discard_Int : Int; pragma Warnings (Off, Discard_Int); begin + pragma Assert (D /= Int'(0)); UI_Div_Vector (Dividend (Dividend'Last - R_Length + 1 .. Dividend'Last), D, diff --git a/gcc/ada/urealp.adb b/gcc/ada/urealp.adb index cf79c07..de31a06 100644 --- a/gcc/ada/urealp.adb +++ b/gcc/ada/urealp.adb @@ -568,6 +568,9 @@ package body Urealp is Num : Uint; begin + pragma Annotate (CodePeer, Modified, Lval); + pragma Annotate (CodePeer, Modified, Rval); + -- Note, in the temporary Ureal_Entry values used in this procedure, -- we store the sign as the sign of the numerator (i.e. xxx.Num may -- be negative, even though in stored entries this can never be so) @@ -685,6 +688,8 @@ package body Urealp is Rneg : constant Boolean := Rval.Negative xor Lval.Negative; begin + pragma Annotate (CodePeer, Modified, Lval); + pragma Annotate (CodePeer, Modified, Rval); pragma Assert (Rval.Num /= Uint_0); if Lval.Rbase = 0 then diff --git a/gcc/ada/xoscons.adb b/gcc/ada/xoscons.adb index 7c72e4e..68784f2 100644 --- a/gcc/ada/xoscons.adb +++ b/gcc/ada/xoscons.adb @@ -494,6 +494,9 @@ procedure XOSCons is Value1 := Get_Value (Slice (Sline, 2)); Value2 := Get_Value (Slice (Sline, 4)); + pragma Annotate (CodePeer, Modified, Value1); + pragma Annotate (CodePeer, Modified, Value2); + if Slice (Sline, 3) = ">" then Res := Cond and (Value1 > Value2); @@ -619,7 +622,7 @@ procedure XOSCons is Current_Line : Integer; Current_Info : Integer; In_Comment : Boolean; - In_Template : Boolean; + In_Template : Boolean := False; -- Start of processing for XOSCons diff --git a/gcc/ada/xr_tabls.adb b/gcc/ada/xr_tabls.adb index a3c9623..604e979 100644 --- a/gcc/ada/xr_tabls.adb +++ b/gcc/ada/xr_tabls.adb @@ -1015,12 +1015,12 @@ package body Xr_Tabls is Decl : Declaration_Reference := Entities_HTable.Get_First; Arr : Reference_Array_Access; Index : Natural; - End_Index : Natural; + End_Index : Natural := 0; Current_File : File_Reference; Current_Line : Cst_String_Access; Buffer : GNAT.OS_Lib.String_Access; Ref : Reference; - Line : Natural; + Line : Natural := Natural'Last; begin -- Create a temporary array, where all references will be diff --git a/gcc/ada/xref_lib.adb b/gcc/ada/xref_lib.adb index eabf8b4..ca988dd 100644 --- a/gcc/ada/xref_lib.adb +++ b/gcc/ada/xref_lib.adb @@ -23,6 +23,8 @@ -- -- ------------------------------------------------------------------------------ +pragma Ada_2012; + with Osint; with Output; use Output; with Types; use Types; @@ -767,13 +769,14 @@ package body Xref_Lib is E_Line : Natural; -- Line number of current entity E_Col : Natural; -- Column number of current entity - E_Type : Character; -- Type of current entity E_Name : Positive; -- Pointer to begin of entity name E_Global : Boolean; -- True iff entity is global + E_Type : Character; -- Type of current entity R_Line : Natural; -- Line number of current reference R_Col : Natural; -- Column number of current reference - R_Type : Character; -- Type of current reference + + R_Type : Character := ASCII.NUL; -- Type of current reference Decl_Ref : Declaration_Reference; File_Ref : File_Reference := Current_Xref_File (File); @@ -876,18 +879,19 @@ package body Xref_Lib is if Ali (Ptr) > ' ' then E_Type := Ali (Ptr); Ptr := Ptr + 1; - end if; - -- Ignore some of the entities (labels,...) + -- Ignore some of the entities (labels,...) - case E_Type is - when 'l' | 'L' | 'q' => + if E_Type in 'l' | 'L' | 'q' then Parse_EOL (Ali, Ptr, Skip_Continuation_Line => True); return; + end if; + else + -- Unexpected contents, skip line and return - when others => - null; - end case; + Parse_EOL (Ali, Ptr, Skip_Continuation_Line => True); + return; + end if; Parse_Number (Ali, Ptr, E_Col); @@ -966,7 +970,7 @@ package body Xref_Lib is Parse_Derived_Info : declare P_Line : Natural; -- parent entity line P_Column : Natural; -- parent entity column - P_Eun : Positive; -- parent entity file number + P_Eun : Natural := 0; -- parent entity file number begin Parse_Number (Ali, Ptr, P_Line); @@ -1010,6 +1014,8 @@ package body Xref_Lib is -- on or if we want to output the type hierarchy if Der_Info or else Type_Tree then + pragma Assert (P_Eun /= 0); + declare Symbol : constant String := Get_Symbol_Name (P_Eun, P_Line, P_Column); @@ -1126,8 +1132,8 @@ package body Xref_Lib is -- 5U14*Foo2 5>20 6b<c,myfoo2>22 # Imported entity -- 5U14*Foo2 5>20 6i<c,myfoo2>22 # Exported entity - if (R_Type = 'b' or else R_Type = 'i') - and then Ali (Ptr) = '<' + if Ali (Ptr) = '<' + and then (R_Type = 'b' or else R_Type = 'i') then while Ptr <= Ali'Last and then Ali (Ptr) /= '>' @@ -1139,6 +1145,8 @@ package body Xref_Lib is Parse_Number (Ali, Ptr, R_Col); + pragma Assert (R_Type /= ASCII.NUL); + -- Insert the reference or body in the table Add_Reference |