+2017-11-09 Javier Miranda <miranda@adacore.com>
+
+ * rtsfind.ads (RE_Id, RE_Unit_Table): Add RE_HT_Link.
+ * exp_disp.adb (Make_DT): Initialize the HT_Link field of the TSD only
+ if available.
+
+2017-11-09 Bob Duff <duff@adacore.com>
+
+ * exp_ch4.adb, exp_ch9.adb, exp_prag.adb, par-ch3.adb, sem_aggr.adb,
+ sem_ch12.adb, sem_ch13.adb, sem_ch4.adb, sem_disp.adb, sem_prag.adb,
+ sem_res.adb, sem_util.adb: Get rid of warnings about uninitialized
+ variables.
+
2017-11-09 Yannick Moy <moy@adacore.com>
* exp_disp.adb (Make_DT): Default initialize Ifaces_List and
if Present (Stored) then
Elmt := First_Elmt (Stored);
+ else
+ Elmt := No_Elmt; -- init to avoid warning
end if;
Cons := New_List;
Call : Node_Id;
Call_Ent : Entity_Id;
Conc_Typ_Stmts : List_Id;
- Concval : Node_Id;
+ Concval : Node_Id := Empty; -- init to avoid warning
D_Alt : constant Node_Id := Delay_Alternative (N);
D_Conv : Node_Id;
D_Disc : Node_Id;
Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of (HT_Link, Loc),
Attribute_Name => Name_Address)));
- else
+
+ elsif RTE_Record_Component_Available (RE_HT_Link) then
Append_To (TSD_Aggr_List,
Unchecked_Convert_To (RTE (RE_Tag_Ptr),
New_Occurrence_Of (RTE (RE_Null_Address), Loc)));
Conseq_Checks : Node_Id := Empty;
Count : Entity_Id;
Count_Decl : Node_Id;
- Error_Decls : List_Id;
+ Error_Decls : List_Id := No_List; -- init to avoid warning
Flag : Entity_Id;
Flag_Decl : Node_Id;
If_Stmt : Node_Id;
Scan_State : Saved_Scan_State;
begin
+ Done := False;
+
if Style_Check then
Style.Check_Indentation;
end if;
=>
Check_Bad_Layout;
Append (P_Subprogram (Pf_Decl_Gins_Pbod_Rnam_Stub_Pexp), Decls);
- Done := False;
when Tok_For =>
Check_Bad_Layout;
Restore_Scan_State (Scan_State);
Append (P_Representation_Clause, Decls);
- Done := False;
when Tok_Generic =>
Check_Bad_Layout;
Append (P_Generic, Decls);
- Done := False;
when Tok_Identifier =>
Check_Bad_Layout;
Token := Tok_Overriding;
Append (P_Subprogram (Pf_Decl_Gins_Pbod_Rnam_Stub_Pexp), Decls);
- Done := False;
-- Normal case, no overriding, or overriding followed by colon
when Tok_Package =>
Check_Bad_Layout;
Append (P_Package (Pf_Decl_Gins_Pbod_Rnam_Stub_Pexp), Decls);
- Done := False;
when Tok_Pragma =>
Append (P_Pragma, Decls);
- Done := False;
when Tok_Protected =>
Check_Bad_Layout;
Scan; -- past PROTECTED
Append (P_Protected, Decls);
- Done := False;
when Tok_Subtype =>
Check_Bad_Layout;
Append (P_Subtype_Declaration, Decls);
- Done := False;
when Tok_Task =>
Check_Bad_Layout;
Scan; -- past TASK
Append (P_Task, Decls);
- Done := False;
when Tok_Type =>
Check_Bad_Layout;
Append (P_Type_Declaration, Decls);
- Done := False;
when Tok_Use =>
Check_Bad_Layout;
P_Use_Clause (Decls);
- Done := False;
when Tok_With =>
Check_Bad_Layout;
-- a declarative list. After discarding the misplaced aspects
-- we can continue the scan.
- Done := False;
-
declare
Dummy_Node : constant Node_Id :=
New_Node (N_Package_Specification, Token_Ptr);
End_Statements (Handled_Statement_Sequence (Body_Node));
end;
- Done := False;
-
else
Done := True;
end if;
-- After discarding the misplaced aspects we can continue the
-- scan.
- Done := False;
else
Restore_Scan_State (Scan_State); -- to END
Done := True;
exception
when Error_Resync =>
Resync_Past_Semicolon;
- Done := False;
end P_Declarative_Items;
----------------------------------
RE_Get_Offset_Index, -- Ada.Tags
RE_Get_Prim_Op_Kind, -- Ada.Tags
RE_Get_Tagged_Kind, -- Ada.Tags
+ RE_HT_Link, -- Ada.Tags
RE_Idepth, -- Ada.Tags
RE_Interfaces_Array, -- Ada.Tags
RE_Interfaces_Table, -- Ada.Tags
RE_Get_Offset_Index => Ada_Tags,
RE_Get_Prim_Op_Kind => Ada_Tags,
RE_Get_Tagged_Kind => Ada_Tags,
+ RE_HT_Link => Ada_Tags,
RE_Idepth => Ada_Tags,
RE_Interfaces_Array => Ada_Tags,
RE_Interfaces_Table => Ada_Tags,
-- Variables used to verify that discriminant-dependent components
-- appear in the same variant.
- Comp_Ref : Entity_Id;
+ Comp_Ref : Entity_Id := Empty; -- init to avoid warning
Variant : Node_Id;
procedure Check_Variant (Id : Entity_Id);
or else
(D2 > D1 and then not Nested_In (Comp_Variant, Variant))
then
+ pragma Assert (Present (Comp_Ref));
Error_Msg_Node_2 := Comp_Ref;
Error_Msg_NE
("& and & appear in different variants", Id, Comp);
Assoc : Node_Id;
Choice : Node_Id;
- Comp_Type : Entity_Id;
+ Comp_Type : Entity_Id := Empty; -- init to avoid warning
-- Start of processing for Resolve_Delta_Record_Aggregate
Next (Choice);
end loop;
+ pragma Assert (Present (Comp_Type));
Analyze_And_Resolve (Expression (Assoc), Comp_Type);
Next (Assoc);
end loop;
Use_Clauses : array (1 .. Scope_Stack_Depth) of Node_Id;
Curr_Scope : Entity_Id := Empty;
- List : Elist_Id;
+ List : Elist_Id := No_Elist; -- init to avoid warning
N_Instances : Nat := 0;
Num_Inner : Nat := 0;
Num_Scopes : Nat := 0;
Chars => New_External_Name
(Chars (Defining_Entity (N)), 'R'));
- Act_Decl_Id : Entity_Id;
+ Act_Decl_Id : Entity_Id := Empty; -- init to avoid warning
Act_Decl : Node_Id;
Act_Spec : Node_Id;
Act_Tree : Node_Id;
-----------------------------------
procedure Analyze_Aspect_Specifications (N : Node_Id; E : Entity_Id) is
+ pragma Assert (Present (E));
+
procedure Decorate (Asp : Node_Id; Prag : Node_Id);
-- Establish linkages between an aspect and its corresponding pragma
Ent : Node_Id;
L : constant List_Id := Aspect_Specifications (N);
+ pragma Assert (Present (L));
Ins_Node : Node_Id := N;
-- Insert pragmas/attribute definition clause after this node when no
-- of visibility for the expression analysis. Thus, we just insert
-- the pragma after the node N.
- pragma Assert (Present (L));
-
-- Loop through aspects
Aspect := First (L);
-----------------------------------------
procedure Analyze_Aspect_Implicit_Dereference is
- Disc : Entity_Id;
- Parent_Disc : Entity_Id;
-
begin
if not Is_Type (E) or else not Has_Discriminants (E) then
Error_Msg_N
-- Missing synchronized types???
- Disc := First_Discriminant (E);
- while Present (Disc) loop
- if Chars (Expr) = Chars (Disc)
- and then Ekind_In (Etype (Disc),
- E_Anonymous_Access_Subprogram_Type,
- E_Anonymous_Access_Type)
- then
- Set_Has_Implicit_Dereference (E);
- Set_Has_Implicit_Dereference (Disc);
- exit;
- end if;
+ declare
+ Disc : Entity_Id := First_Discriminant (E);
+ begin
+ while Present (Disc) loop
+ if Chars (Expr) = Chars (Disc)
+ and then Ekind_In
+ (Etype (Disc),
+ E_Anonymous_Access_Subprogram_Type,
+ E_Anonymous_Access_Type)
+ then
+ Set_Has_Implicit_Dereference (E);
+ Set_Has_Implicit_Dereference (Disc);
+ exit;
+ end if;
- Next_Discriminant (Disc);
- end loop;
+ Next_Discriminant (Disc);
+ end loop;
- -- Error if no proper access discriminant
+ -- Error if no proper access discriminant
- if No (Disc) then
- Error_Msg_NE ("not an access discriminant of&", Expr, E);
- return;
- end if;
- end if;
+ if Present (Disc) then
+ -- For a type extension, check whether parent has
+ -- a reference discriminant, to verify that use is
+ -- proper.
- -- For a type extension, check whether parent has a
- -- reference discriminant, to verify that use is proper.
-
- if Is_Derived_Type (E)
- and then Has_Discriminants (Etype (E))
- then
- Parent_Disc := Get_Reference_Discriminant (Etype (E));
+ if Is_Derived_Type (E)
+ and then Has_Discriminants (Etype (E))
+ then
+ declare
+ Parent_Disc : constant Entity_Id :=
+ Get_Reference_Discriminant (Etype (E));
+ begin
+ if Present (Parent_Disc)
+ and then Corresponding_Discriminant (Disc) /=
+ Parent_Disc
+ then
+ Error_Msg_N
+ ("reference discriminant does not match "
+ & "discriminant of parent type", Expr);
+ end if;
+ end;
+ end if;
- if Present (Parent_Disc)
- and then Corresponding_Discriminant (Disc) /= Parent_Disc
- then
- Error_Msg_N
- ("reference discriminant does not match discriminant "
- & "of parent type", Expr);
- end if;
+ else
+ Error_Msg_NE
+ ("not an access discriminant of&", Expr, E);
+ end if;
+ end;
end if;
+
end Analyze_Aspect_Implicit_Dereference;
-----------------------
Max : Uint;
-- Minimum and maximum values of entries
- Max_Node : Node_Id;
+ Max_Node : Node_Id := Empty; -- init to avoid warning
-- Pointer to node for literal providing max value
begin
-- This is the expression for the result of the function. It is
-- is build by connecting the component predicates with AND THEN.
- Expr_M : Node_Id;
+ Expr_M : Node_Id := Empty; -- init to avoid warning
-- This is the corresponding return expression for the Predicate_M
-- function. It differs in that raise expressions are marked for
-- special expansion (see Process_REs).
-- this tagged type and the parent component. Tagged_Parent will point
-- to this parent type. For all other cases, Tagged_Parent is Empty.
- Parent_Last_Bit : Uint;
+ Parent_Last_Bit : Uint := No_Uint; -- init to avoid warning
-- Relevant only if Tagged_Parent is set, Parent_Last_Bit indicates the
-- last bit position for any field in the parent type. We only need to
-- check overlap for fields starting below this point.
else
declare
- Outermost : Node_Id;
+ Outermost : Node_Id := Empty; -- init to avoid warning
P : Node_Id := N;
begin
while Present (P) loop
-
-- For object declarations we can climb to the node from
-- its object definition branch or from its initializing
-- expression. We prefer to mark the child node as the
Outermost := P;
end if;
- -- Avoid climbing more than needed!
+ -- Avoid climbing more than needed
exit when Stop_Subtree_Climbing (Nkind (P))
or else (Nkind (P) = N_Range
declare
Dup_Call_Node : constant Node_Id := New_Copy (New_Call_Node);
- CW_Result : Boolean;
- Prim_Result : Boolean;
- pragma Unreferenced (CW_Result);
+ Ignore : Boolean;
+ Prim_Result : Boolean := False;
begin
if not CW_Test_Only then
-- was found in order to report ambiguous calls.
if not Prim_Result then
- CW_Result :=
+ Ignore :=
Try_Class_Wide_Operation
(Call_Node => New_Call_Node,
Node_To_Replace => Node_To_Replace);
-- decoration if there is no ambiguity).
else
- CW_Result :=
+ Ignore :=
Try_Class_Wide_Operation
(Call_Node => Dup_Call_Node,
Node_To_Replace => Node_To_Replace);
Func : Entity_Id;
Subp_Entity : Entity_Id;
Indeterm_Ancestor_Call : Boolean := False;
- Indeterm_Ctrl_Type : Entity_Id;
+ Indeterm_Ctrl_Type : Entity_Id := Empty; -- init to avoid warning
Static_Tag : Node_Id := Empty;
-- If a controlling formal has a statically tagged actual, the tag of
procedure Check_Grouping (L : List_Id) is
HSS : Node_Id;
- Prag : Node_Id;
Stmt : Node_Id;
+ Prag : Node_Id := Empty; -- init to avoid warning
begin
-- Inspect the list of declarations or statements looking for
else
while Present (Stmt) loop
-
-- The current pragma is either the first pragma
- -- of the group or is a member of the group. Stop
- -- the search as the placement is legal.
+ -- of the group or is a member of the group.
+ -- Stop the search as the placement is legal.
if Stmt = N then
raise Stop_Search;
- -- Skip group members, but keep track of the last
- -- pragma in the group.
+ -- Skip group members, but keep track of the
+ -- last pragma in the group.
elsif Is_Loop_Pragma (Stmt) then
Prag := Stmt;
SPARK_Msg_N
("expression of external state property must be "
& "static", Expr);
+ return;
end if;
-- The lack of expression defaults the property to True
return;
end if;
+ -- Ada 2012 (AI05-0030): Cannot apply the implementation_kind
+ -- By_Protected_Procedure to the primitive procedure of a task
+ -- interface.
+
+ if Chars (Arg2) = Name_By_Protected_Procedure
+ and then Is_Interface (Typ)
+ and then Is_Task_Interface (Typ)
+ then
+ Error_Pragma_Arg
+ ("implementation kind By_Protected_Procedure cannot be "
+ & "applied to a task interface primitive", Arg2);
+ return;
+ end if;
+
-- Procedures declared inside a protected type must be accepted
elsif Ekind (Proc_Id) = E_Procedure
return;
end if;
- -- Ada 2012 (AI05-0030): Cannot apply the implementation_kind
- -- By_Protected_Procedure to the primitive procedure of a task
- -- interface.
-
- if Chars (Arg2) = Name_By_Protected_Procedure
- and then Is_Interface (Typ)
- and then Is_Task_Interface (Typ)
- then
- Error_Pragma_Arg
- ("implementation kind By_Protected_Procedure cannot be "
- & "applied to a task interface primitive", Arg2);
- return;
- end if;
-
Record_Rep_Item (Proc_Id, N);
end Implemented;
else
OK := Set_Warning_Switch (Chr);
end if;
- end if;
- if not OK then
+ if not OK then
+ Error_Pragma_Arg
+ ("invalid warning switch character " & Chr,
+ Arg1);
+ end if;
+
+ else
Error_Pragma_Arg
- ("invalid warning switch character " & Chr,
+ ("invalid wide character in warning switch ",
Arg1);
end if;
Loc : constant Source_Ptr := Sloc (N);
A : Node_Id;
A_Id : Entity_Id;
- A_Typ : Entity_Id;
+ A_Typ : Entity_Id := Empty; -- init to avoid warning
F : Entity_Id;
F_Typ : Entity_Id;
Prev : Node_Id := Empty;
Orig_A : Node_Id;
- Real_F : Entity_Id;
+ Real_F : Entity_Id := Empty; -- init to avoid warning
Real_Subp : Entity_Id;
-- If the subprogram being called is an inherited operation for
Anc_Part : Node_Id;
Assoc : Node_Id;
Choice : Node_Id;
- Comp_Typ : Entity_Id;
+ Comp_Typ : Entity_Id := Empty; -- init to avoid warning
Expr : Node_Id;
begin
-- The type of the choice must have preelaborable initialization if
-- the association carries a <>.
+ pragma Assert (Present (Comp_Typ));
if Box_Present (Assoc) then
if not Has_Preelaborable_Initialization (Comp_Typ) then
return False;
L_Ndims : constant Nat := Number_Dimensions (L_Typ);
R_Ndims : constant Nat := Number_Dimensions (R_Typ);
- L_Index : Node_Id;
- R_Index : Node_Id;
+ L_Index : Node_Id := Empty; -- init to ...
+ R_Index : Node_Id := Empty; -- ...avoid warnings
L_Low : Node_Id;
L_High : Node_Id;
L_Len : Uint;
projects / gcc.git / commitdiff