+2010-06-23 Robert Dewar <dewar@adacore.com>
+
+ * 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 <dewar@adacore.com>
* errout.adb (Finalize): Set Prev pointers.
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
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
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;
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);
-- Start of processing for Expand_N_In
begin
-
if Present (Alternatives (N)) then
Remove_Side_Effects (Lop);
Expand_Set_Membership;
procedure Make_Temporary_For_Slice is
Decl : Node_Id;
Ent : constant Entity_Id := Make_Temporary (Loc, 'T', N);
+
begin
Decl :=
Make_Object_Declaration (Loc,
Cons : List_Id;
begin
-
-- Nothing else to do if no change of representation
if Same_Representation (Operand_Type, Target_Type) then
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);
-- 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
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;
----------------------------
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
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
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
-- 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)
-- 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
if Style_Check then
Style.Check_Identifier (Body_Id, Gen_Id);
end if;
+
End_Generic;
end Analyze_Generic_Subprogram_Body;
OSDN Git Service
