diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index a16bc19fbf50..b16e44a412b8 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2010-06-23 Robert Dewar + + * sem_ch6.adb, exp_ch4.adb, s-rannum.ads, sem.adb, sem_ch12.adb: Minor + reformatting. Add comments. + * errout.adb (Finalize): Properly adjust warning count when deleting + continuations. + 2010-06-22 Robert Dewar * errout.adb (Finalize): Set Prev pointers. diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb index 935bc5857d1e..e307ce7e44d8 100644 --- a/gcc/ada/errout.adb +++ b/gcc/ada/errout.adb @@ -1215,6 +1215,23 @@ package body Errout is Nxt : Error_Msg_Id; F : Error_Msg_Id; + procedure Delete_Warning (E : Error_Msg_Id); + -- Delete a message if not already deleted and adjust warning count + + -------------------- + -- Delete_Warning -- + -------------------- + + procedure Delete_Warning (E : Error_Msg_Id) is + begin + if not Errors.Table (E).Deleted then + Errors.Table (E).Deleted := True; + Warnings_Detected := Warnings_Detected - 1; + end if; + end Delete_Warning; + + -- Start of message for Finalize + begin -- Set Prev pointers @@ -1252,15 +1269,14 @@ package body Errout is and then Warning_Specifically_Suppressed (Errors.Table (Cur).Sptr, Errors.Table (Cur).Text) then - Errors.Table (Cur).Deleted := True; - Warnings_Detected := Warnings_Detected - 1; + Delete_Warning (Cur); -- If this is a continuation, delete previous messages F := Cur; while Errors.Table (F).Msg_Cont loop F := Errors.Table (F).Prev; - Errors.Table (F).Deleted := True; + Delete_Warning (F); end loop; -- Delete any following continuations @@ -1270,7 +1286,7 @@ package body Errout is F := Errors.Table (F).Next; exit when F = No_Error_Msg; exit when not Errors.Table (F).Msg_Cont; - Errors.Table (F).Deleted := True; + Delete_Warning (F); end loop; end if; diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 4112254bd301..43477cb51d2e 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -3155,9 +3155,10 @@ package body Exp_Ch4 is declare Decl : Node_Id; Outer_S : Entity_Id; - S : Entity_Id := Current_Scope; + S : Entity_Id; begin + S := Current_Scope; while Present (S) and then S /= Standard_Standard loop if Ekind (S) = E_Function then Outer_S := Scope (S); @@ -4369,7 +4370,6 @@ package body Exp_Ch4 is -- Start of processing for Expand_N_In begin - if Present (Alternatives (N)) then Remove_Side_Effects (Lop); Expand_Set_Membership; @@ -7658,6 +7658,7 @@ package body Exp_Ch4 is procedure Make_Temporary_For_Slice is Decl : Node_Id; Ent : constant Entity_Id := Make_Temporary (Loc, 'T', N); + begin Decl := Make_Object_Declaration (Loc, @@ -7793,7 +7794,6 @@ package body Exp_Ch4 is Cons : List_Id; begin - -- Nothing else to do if no change of representation if Same_Representation (Operand_Type, Target_Type) then @@ -8727,7 +8727,6 @@ package body Exp_Ch4 is procedure Expand_N_Unchecked_Expression (N : Node_Id) is Exp : constant Node_Id := Expression (N); - begin Set_Assignment_OK (Exp, Assignment_OK (N) or else Assignment_OK (Exp)); Rewrite (N, Exp); @@ -8751,6 +8750,7 @@ package body Exp_Ch4 is -- an Assignment_OK indication which must be propagated to the operand. if Operand_Type = Target_Type then + -- Code duplicates Expand_N_Unchecked_Expression above, factor??? if Assignment_OK (N) then diff --git a/gcc/ada/s-rannum.ads b/gcc/ada/s-rannum.ads index b7031d47c6f2..0d2a7e9dee72 100644 --- a/gcc/ada/s-rannum.ads +++ b/gcc/ada/s-rannum.ads @@ -141,10 +141,13 @@ private type Generator is limited record Writable : Writable_Access (Generator'Access); -- This self reference allows functions to modify Generator arguments - S : State := (others => 0); + + S : State := (others => 0); -- The shift register, a circular buffer - I : Integer := N; + + I : Integer := N; -- Current starting position in shift register S (N means uninitialized) + -- We should avoid using the identifier I here ??? end record; end System.Random_Numbers; diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb index 71989ada4d2a..e2c1e3c474b3 100644 --- a/gcc/ada/sem.adb +++ b/gcc/ada/sem.adb @@ -1727,15 +1727,12 @@ package body Sem is ---------------------------- procedure Do_Unit_And_Dependents (CU : Node_Id; Item : Node_Id) is - Unit_Num : constant Unit_Number_Type := - Get_Cunit_Unit_Number (CU); + Unit_Num : constant Unit_Number_Type := Get_Cunit_Unit_Number (CU); Child : Node_Id; Parent_CU : Node_Id; procedure Do_Withed_Units is new Walk_Withs (Do_Withed_Unit); - -- Start of processing for Do_Unit_And_Dependents - begin if not Seen (Unit_Num) then @@ -1749,7 +1746,6 @@ package body Sem is if not Nkind_In (Item, N_Package_Body, N_Subprogram_Body) or else Acts_As_Spec (CU) then - if CU = Cunit (Main_Unit) and then not Do_Main then diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 1f28f9d544f4..ea596845e265 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -10396,7 +10396,7 @@ package body Sem_Ch12 is procedure Mark_Context (Inst_Decl : Node_Id; Gen_Decl : Node_Id) is Inst_CU : constant Unit_Number_Type := Get_Code_Unit (Inst_Decl); Gen_CU : constant Unit_Number_Type := Get_Source_Unit (Gen_Decl); - Inst : Entity_Id := Cunit_Entity (Inst_CU); + Inst : Entity_Id; Clause : Node_Id; begin @@ -10420,11 +10420,12 @@ package body Sem_Ch12 is -- If the with-clause for the generic unit was not found, it must -- appear in some ancestor of the current unit. + Inst := Cunit_Entity (Inst_CU); while Is_Child_Unit (Inst) loop Inst := Scope (Inst); + Clause := First (Context_Items (Parent (Unit_Declaration_Node (Inst)))); - while Present (Clause) loop if Nkind (Clause) = N_With_Clause and then Library_Unit (Clause) = Cunit (Gen_CU) diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 171cb0a267ed..df74d5b969ec 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -110,7 +110,8 @@ package body Sem_Ch6 is -- outer homographs. procedure Analyze_Subprogram_Body_Helper (N : Node_Id); - -- Does all the real work of Analyze_Subprogram_Body + -- Does all the real work of Analyze_Subprogram_Body. This is split out so + -- that we can use RETURN but not skip the debug output at the end. procedure Analyze_Generic_Subprogram_Body (N : Node_Id; Gen_Id : Entity_Id); -- Analyze a generic subprogram body. N is the body to be analyzed, and @@ -978,6 +979,7 @@ package body Sem_Ch6 is if Style_Check then Style.Check_Identifier (Body_Id, Gen_Id); end if; + End_Generic; end Analyze_Generic_Subprogram_Body;