Index: sem_aggr.adb =================================================================== --- sem_aggr.adb (revision 254573) +++ sem_aggr.adb (working copy) @@ -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; Index: exp_prag.adb =================================================================== --- exp_prag.adb (revision 254563) +++ exp_prag.adb (working copy) @@ -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; Index: sem_prag.adb =================================================================== --- sem_prag.adb (revision 254570) +++ sem_prag.adb (working copy) @@ -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; Index: sem_ch12.adb =================================================================== --- sem_ch12.adb (revision 254570) +++ sem_ch12.adb (working copy) @@ -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; Index: sem_ch4.adb =================================================================== --- sem_ch4.adb (revision 254571) +++ sem_ch4.adb (working copy) @@ -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); Index: sem_ch13.adb =================================================================== --- sem_ch13.adb (revision 254563) +++ sem_ch13.adb (working copy) @@ -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. Index: par-ch3.adb =================================================================== --- par-ch3.adb (revision 254563) +++ par-ch3.adb (working copy) @@ -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; ---------------------------------- Index: sem_util.adb =================================================================== --- sem_util.adb (revision 254566) +++ sem_util.adb (working copy) @@ -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; Index: sem_res.adb =================================================================== --- sem_res.adb (revision 254571) +++ sem_res.adb (working copy) @@ -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 Index: exp_ch9.adb =================================================================== --- exp_ch9.adb (revision 254570) +++ exp_ch9.adb (working copy) @@ -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; Index: sem_disp.adb =================================================================== --- sem_disp.adb (revision 254563) +++ sem_disp.adb (working copy) @@ -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 Index: exp_ch4.adb =================================================================== --- exp_ch4.adb (revision 254570) +++ exp_ch4.adb (working copy) @@ -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;