===================================================================
@@ -2882,7 +2882,7 @@
-- 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);
@@ -2941,6 +2941,7 @@
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);
@@ -3025,7 +3026,7 @@
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
@@ -3045,6 +3046,7 @@
Next (Choice);
end loop;
+ pragma Assert (Present (Comp_Type));
Analyze_And_Resolve (Expression (Assoc), Comp_Type);
Next (Assoc);
end loop;
===================================================================
@@ -1090,7 +1090,7 @@
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;
===================================================================
@@ -5817,8 +5817,8 @@
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
@@ -5872,16 +5872,15 @@
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;
@@ -11390,6 +11389,7 @@
SPARK_Msg_N
("expression of external state property must be "
& "static", Expr);
+ return;
end if;
-- The lack of expression defaults the property to True
@@ -16474,6 +16474,20 @@
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
@@ -16489,20 +16503,6 @@
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;
@@ -24253,11 +24253,16 @@
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;
===================================================================
@@ -4761,7 +4761,7 @@
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;
@@ -5136,7 +5136,7 @@
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;
===================================================================
@@ -1075,12 +1075,11 @@
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
@@ -1095,7 +1094,7 @@
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
@@ -9151,9 +9150,8 @@
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
@@ -9168,7 +9166,7 @@
-- 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);
@@ -9178,7 +9176,7 @@
-- 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);
===================================================================
@@ -1360,6 +1360,8 @@
-----------------------------------
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
@@ -1578,6 +1580,7 @@
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
@@ -1605,8 +1608,6 @@
-- 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);
@@ -1906,9 +1907,6 @@
-----------------------------------------
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
@@ -1924,45 +1922,56 @@
-- 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
+ 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 Is_Derived_Type (E)
- and then Has_Discriminants (Etype (E))
- then
- Parent_Disc := Get_Reference_Discriminant (Etype (E));
+ else
+ Error_Msg_NE
+ ("not an access discriminant of&", Expr, E);
+ 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;
- end if;
end Analyze_Aspect_Implicit_Dereference;
-----------------------
@@ -6529,7 +6538,7 @@
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
@@ -8384,7 +8393,7 @@
-- 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).
@@ -9925,7 +9934,7 @@
-- 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.
===================================================================
@@ -4314,6 +4314,8 @@
Scan_State : Saved_Scan_State;
begin
+ Done := False;
+
if Style_Check then
Style.Check_Indentation;
end if;
@@ -4326,7 +4328,6 @@
=>
Check_Bad_Layout;
Append (P_Subprogram (Pf_Decl_Gins_Pbod_Rnam_Stub_Pexp), Decls);
- Done := False;
when Tok_For =>
Check_Bad_Layout;
@@ -4350,12 +4351,10 @@
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;
@@ -4370,7 +4369,6 @@
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
@@ -4381,38 +4379,31 @@
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;
@@ -4439,8 +4430,6 @@
-- 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);
@@ -4533,8 +4522,6 @@
End_Statements (Handled_Statement_Sequence (Body_Node));
end;
- Done := False;
-
else
Done := True;
end if;
@@ -4556,7 +4543,6 @@
-- After discarding the misplaced aspects we can continue the
-- scan.
- Done := False;
else
Restore_Scan_State (Scan_State); -- to END
Done := True;
@@ -4671,7 +4657,6 @@
exception
when Error_Resync =>
Resync_Past_Semicolon;
- Done := False;
end P_Declarative_Items;
----------------------------------
===================================================================
@@ -15448,7 +15448,7 @@
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
@@ -15524,6 +15524,7 @@
-- 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;
@@ -17558,8 +17559,8 @@
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;
===================================================================
@@ -3144,12 +3144,12 @@
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
===================================================================
@@ -12355,7 +12355,7 @@
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;
===================================================================
@@ -404,7 +404,7 @@
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
===================================================================
@@ -10749,6 +10749,8 @@
if Present (Stored) then
Elmt := First_Elmt (Stored);
+ else
+ Elmt := No_Elmt; -- init to avoid warning
end if;
Cons := New_List;