OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

exp_ch5.adb, [...]: Minor reformatting. 

2016-10-12  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch5.adb, sem_ch3.adb, exp_ch9.adb, a-tags.adb, sem_prag.adb,
	sem_ch12.adb, xref_lib.adb, a-strunb-shared.adb, rtsfind.adb,
	freeze.adb, sem_attr.adb, sem_case.adb, exp_ch4.adb, ghost.adb,
	exp_ch6.adb, sem_ch4.adb, restrict.adb, s-os_lib.adb: Minor
	reformatting.

From-SVN: r241041
This commit is contained in:
Hristian Kirtchev 2016-10-12 12:59:57 +00:00 committed by Arnaud Charlet
parent 0026dd0a63
commit f31dcd99ac
19 changed files with 265 additions and 235 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
gcc/ada/ChangeLog
View File

@ -1,3 +1,11 @@
2016-10-12 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch5.adb, sem_ch3.adb, exp_ch9.adb, a-tags.adb, sem_prag.adb,
sem_ch12.adb, xref_lib.adb, a-strunb-shared.adb, rtsfind.adb,
freeze.adb, sem_attr.adb, sem_case.adb, exp_ch4.adb, ghost.adb,
exp_ch6.adb, sem_ch4.adb, restrict.adb, s-os_lib.adb: Minor
reformatting.
2016-10-12 Justin Squirek <squirek@adacore.com>
* sem_ch10.adb (Remove_Limited_With_Clause): Add a check to

3
gcc/ada/a-strunb-shared.adb
View File

@ -625,7 +625,8 @@ package body Ada.Strings.Unbounded is
function Can_Be_Reused
(Item : not null Shared_String_Access;
Length : Natural) return Boolean is
Length : Natural) return Boolean
is
begin
return
System.Atomic_Counters.Is_One (Item.Counter)

8
gcc/ada/a-tags.adb
View File

@ -757,10 +757,10 @@ package body Ada.Tags is
A_TSD : constant Type_Specific_Data_Ptr :=
To_Type_Specific_Data_Ptr (A_TSD_Ptr.all);
begin
return D_TSD.Access_Level = A_TSD.Access_Level
and then (CW_Membership (Descendant, Ancestor)
or else
IW_Membership (D_TSD, Ancestor));
return
D_TSD.Access_Level = A_TSD.Access_Level
and then (CW_Membership (Descendant, Ancestor)
or else IW_Membership (D_TSD, Ancestor));
end;
end if;
end Is_Descendant_At_Same_Level;

3
gcc/ada/exp_ch4.adb
View File

@ -4280,8 +4280,9 @@ package body Exp_Ch4 is
if Nkind (Expression (N)) = N_Qualified_Expression then
declare
Exp : constant Node_Id := Expression (Expression (N));
Exp : constant Node_Id := Expression (Expression (N));
Typ : constant Entity_Id := Etype (Expression (N));
begin
Apply_Constraint_Check (Exp, Typ);
Apply_Predicate_Check (Exp, Typ);

5
gcc/ada/exp_ch5.adb
View File

@ -330,10 +330,11 @@ package body Exp_Ch5 is
case Nkind (Exp) is
when N_Indexed_Component | N_Selected_Component | N_Slice =>
return Is_Non_Local_Array (Prefix (Exp));
when others =>
return
not (Is_Entity_Name (Exp) and then
Scope (Entity (Exp)) = Current_Scope);
not (Is_Entity_Name (Exp)
and then Scope (Entity (Exp)) = Current_Scope);
end case;
end Is_Non_Local_Array;

10
gcc/ada/exp_ch6.adb
View File

@ -5943,7 +5943,7 @@ package body Exp_Ch6 is
Subp : Entity_Id;
Scop : Entity_Id)
is
Rec : Node_Id;
Rec : Node_Id;
procedure Expand_Internal_Init_Call;
-- A call to an operation of the type may occur in the initialization
@ -6006,7 +6006,7 @@ package body Exp_Ch6 is
-- case this must be handled as an inter-object call.
if not In_Open_Scopes (Scop)
or else (not Is_Entity_Name (Name (N)))
or else not Is_Entity_Name (Name (N))
then
if Nkind (Name (N)) = N_Selected_Component then
Rec := Prefix (Name (N));
@ -6020,8 +6020,9 @@ package body Exp_Ch6 is
-- function of that enclosing type, and this is treated as an
-- internal call.
pragma Assert (Is_Entity_Name (Name (N))
and then Inside_Init_Proc);
pragma Assert
(Is_Entity_Name (Name (N)) and then Inside_Init_Proc);
Expand_Internal_Init_Call;
return;
end if;
@ -6044,7 +6045,6 @@ package body Exp_Ch6 is
Name => Name (N),
Rec => Rec,
External => False);
end if;
-- Analyze and resolve the new call. The actuals have already been

18
gcc/ada/exp_ch9.adb
View File

@ -1106,8 +1106,8 @@ package body Exp_Ch9 is
procedure Build_Class_Wide_Master (Typ : Entity_Id) is
Loc : constant Source_Ptr := Sloc (Typ);
Master_Id : Entity_Id;
Master_Decl : Node_Id;
Master_Id : Entity_Id;
Master_Scope : Entity_Id;
Name_Id : Node_Id;
Related_Node : Node_Id;
@ -8390,21 +8390,25 @@ package body Exp_Ch9 is
procedure Expand_N_Delay_Relative_Statement (N : Node_Id) is
Loc : constant Source_Ptr := Sloc (N);
Proc : Entity_Id;
begin
-- Try to use System.Relative_Delays.Delay_For only if available. This
-- is the implementation used on restricted platforms when Ada.Calendar
-- is not available.
if RTE_Available (RO_RD_Delay_For) then
-- Try to use System.Relative_Delays.Delay_For only if available.
-- This is the implementation used on restricted platforms when
-- Ada.Calendar is not available.
Proc := RTE (RO_RD_Delay_For);
-- Otherwise, use Ada.Calendar.Delays.Delay_For and emit an error
-- message if not available.
else
-- Otherwise, use Ada.Calendar.Delays.Delay_For and emit an error
-- message if not available.
Proc := RTE (RO_CA_Delay_For);
end if;
Rewrite (N,
Make_Procedure_Call_Statement (Loc,
Name => New_Occurrence_Of (Proc, Loc),
Name => New_Occurrence_Of (Proc, Loc),
Parameter_Associations => New_List (Expression (N))));
Analyze (N);
end Expand_N_Delay_Relative_Statement;

6
gcc/ada/freeze.adb
View File

@ -1408,7 +1408,7 @@ package body Freeze is
-- care of all overridings and is done only once.
if Present (Overridden_Operation (Prim))
and then Comes_From_Source (Prim)
and then Comes_From_Source (Prim)
then
Update_Primitives_Mapping (Overridden_Operation (Prim), Prim);
@ -1444,9 +1444,7 @@ package body Freeze is
Op_Node := First_Elmt (Prim_Ops);
while Present (Op_Node) loop
Prim := Node (Op_Node);
if not Comes_From_Source (Prim)
and then Present (Alias (Prim))
then
if not Comes_From_Source (Prim) and then Present (Alias (Prim)) then
Par_Prim := Alias (Prim);
A_Pre := Find_Aspect (Par_Prim, Aspect_Pre);

4
gcc/ada/ghost.adb
View File

@ -617,9 +617,9 @@ package body Ghost is
-- A non-Ghost primitive of a type extension cannot override an
-- inherited Ghost primitive (SPARK RM 6.9(8)).
if not Is_Ghost_Entity (Subp)
if Is_Ghost_Entity (Over_Subp)
and then not Is_Ghost_Entity (Subp)
and then not Is_Abstract_Subprogram (Subp)
and then Is_Ghost_Entity (Over_Subp)
then
Error_Msg_N ("incompatible overriding in effect", Subp);

12
gcc/ada/restrict.adb
View File

@ -1195,17 +1195,17 @@ package body Restrict is
declare
R : Restriction_Flags renames
Profile_Info (Restricted_Tasking).Set;
Profile_Info (Restricted_Tasking).Set;
V : Restriction_Values renames
Profile_Info (Restricted_Tasking).Value;
Profile_Info (Restricted_Tasking).Value;
begin
for J in R'Range loop
if R (J)
and then (Restrictions.Set (J) = False
or else Restriction_Warnings (J)
or else
(J in All_Parameter_Restrictions
and then Restrictions.Value (J) > V (J)))
or else Restriction_Warnings (J)
or else
(J in All_Parameter_Restrictions
and then Restrictions.Value (J) > V (J)))
then
Restricted_Profile_Result := False;
exit;

10
gcc/ada/rtsfind.adb
View File

@ -1169,15 +1169,19 @@ package body Rtsfind is
M (P + 1) := '.';
P := P + 1;
-- Add entity name and closing quote to message
-- Strip "RE"
if RE_Image (2) = 'E' then
-- Strip "RE"
S := 4;
-- Strip "RO_XX"
else
-- Strip "RO_XX"
S := 7;
end if;
-- Add entity name and closing quote to message
Name_Len := RE_Image'Length - S + 1;
Name_Buffer (1 .. Name_Len) := RE_Image (S .. RE_Image'Last);
Set_Casing (Mixed_Case);

26
gcc/ada/s-os_lib.adb
View File

@ -511,7 +511,6 @@ package body System.OS_Lib is
when None =>
null;
end case;
end Copy_To;
-- Start of processing for Copy_File
@ -622,6 +621,7 @@ package body System.OS_Lib is
Ada_Pathname : String_Access :=
To_Path_String_Access
(Pathname, C_String_Length (Pathname));
begin
Copy_File (Ada_Name.all, Ada_Pathname.all, Success, Mode, Preserve);
Free (Ada_Name);
@ -639,9 +639,10 @@ package body System.OS_Lib is
Copy_Timestamp : Boolean := True;
Copy_Permissions : Boolean := True)
is
F : aliased String (1 .. From'Length + 1);
F : aliased String (1 .. From'Length + 1);
T : aliased String (1 .. To'Length + 1);
Mode : Integer;
T : aliased String (1 .. To'Length + 1);
begin
if Copy_Timestamp then
@ -713,6 +714,7 @@ package body System.OS_Lib is
Ada_Dest : String_Access :=
To_Path_String_Access
(Dest, C_String_Length (Dest));
begin
Copy_Time_Stamps (Ada_Source.all, Ada_Dest.all, Success);
Free (Ada_Source);
@ -1504,6 +1506,7 @@ package body System.OS_Lib is
pragma Import
(C, Is_Read_Accessible_File, "__gnat_is_read_accessible_file");
F_Name : String (1 .. Name'Length + 1);
begin
F_Name (1 .. Name'Length) := Name;
F_Name (F_Name'Last) := ASCII.NUL;
@ -1595,6 +1598,7 @@ package body System.OS_Lib is
pragma Import
(C, Is_Write_Accessible_File, "__gnat_is_write_accessible_file");
F_Name : String (1 .. Name'Length + 1);
begin
F_Name (1 .. Name'Length) := Name;
F_Name (F_Name'Last) := ASCII.NUL;
@ -1849,8 +1853,8 @@ package body System.OS_Lib is
else
Result :=
Non_Blocking_Spawn
(Program_Name, Args, Output_File_Descriptor, Err_To_Out);
Non_Blocking_Spawn
(Program_Name, Args, Output_File_Descriptor, Err_To_Out);
-- Close the file just created for the output, as the file descriptor
-- cannot be used anywhere, being a local value. It is safe to do
@ -2628,6 +2632,7 @@ package body System.OS_Lib is
function rename (From, To : Address) return Integer;
pragma Import (C, rename, "__gnat_rename");
R : Integer;
begin
R := rename (Old_Name, New_Name);
Success := (R = 0);
@ -2640,6 +2645,7 @@ package body System.OS_Lib is
is
C_Old_Name : String (1 .. Old_Name'Length + 1);
C_New_Name : String (1 .. New_Name'Length + 1);
begin
C_Old_Name (1 .. Old_Name'Length) := Old_Name;
C_Old_Name (C_Old_Name'Last) := ASCII.NUL;
@ -2673,6 +2679,7 @@ package body System.OS_Lib is
procedure C_Set_Executable (Name : C_File_Name; Mode : Integer);
pragma Import (C, C_Set_Executable, "__gnat_set_executable");
C_Name : aliased String (Name'First .. Name'Last + 1);
begin
C_Name (Name'Range) := Name;
C_Name (C_Name'Last) := ASCII.NUL;
@ -2687,6 +2694,7 @@ package body System.OS_Lib is
procedure C_Set_File_Time (Name : C_File_Name; Time : OS_Time);
pragma Import (C, C_Set_File_Time, "__gnat_set_file_time_name");
C_Name : aliased String (Name'First .. Name'Last + 1);
begin
C_Name (Name'Range) := Name;
C_Name (C_Name'Last) := ASCII.NUL;
@ -2701,6 +2709,7 @@ package body System.OS_Lib is
procedure C_Set_Non_Readable (Name : C_File_Name);
pragma Import (C, C_Set_Non_Readable, "__gnat_set_non_readable");
C_Name : aliased String (Name'First .. Name'Last + 1);
begin
C_Name (Name'Range) := Name;
C_Name (C_Name'Last) := ASCII.NUL;
@ -2715,6 +2724,7 @@ package body System.OS_Lib is
procedure C_Set_Non_Writable (Name : C_File_Name);
pragma Import (C, C_Set_Non_Writable, "__gnat_set_non_writable");
C_Name : aliased String (Name'First .. Name'Last + 1);
begin
C_Name (Name'Range) := Name;
C_Name (C_Name'Last) := ASCII.NUL;
@ -2729,6 +2739,7 @@ package body System.OS_Lib is
procedure C_Set_Readable (Name : C_File_Name);
pragma Import (C, C_Set_Readable, "__gnat_set_readable");
C_Name : aliased String (Name'First .. Name'Last + 1);
begin
C_Name (Name'Range) := Name;
C_Name (C_Name'Last) := ASCII.NUL;
@ -2743,6 +2754,7 @@ package body System.OS_Lib is
procedure C_Set_Writable (Name : C_File_Name);
pragma Import (C, C_Set_Writable, "__gnat_set_writable");
C_Name : aliased String (Name'First .. Name'Last + 1);
begin
C_Name (Name'Range) := Name;
C_Name (C_Name'Last) := ASCII.NUL;
@ -2889,8 +2901,8 @@ package body System.OS_Lib is
type Chars is array (Positive range <>) of aliased Character;
type Char_Ptr is access constant Character;
Command_Len : constant Positive := Program_Name'Length + 1 +
Args_Length (Args);
Command_Len : constant Positive :=
Program_Name'Length + 1 + Args_Length (Args);
Command_Last : Natural := 0;
Command : aliased Chars (1 .. Command_Len);
-- Command contains all characters of the Program_Name and Args, all

271
gcc/ada/sem_attr.adb
View File

@ -68,7 +68,6 @@ with Stand; use Stand;
with Sinfo; use Sinfo;
with Sinput; use Sinput;
with System;
with System.CRC32; use System.CRC32;
with Stringt; use Stringt;
with Style;
with Stylesw; use Stylesw;
@ -79,6 +78,8 @@ with Uintp; use Uintp;
with Uname; use Uname;
with Urealp; use Urealp;
with System.CRC32; use System.CRC32;
package body Sem_Attr is
True_Value : constant Uint := Uint_1;
@ -5288,7 +5289,8 @@ package body Sem_Attr is
-- Local variables
In_Inlined_C_Postcondition : constant Boolean :=
Modify_Tree_For_C and then In_Inlined_Body;
Modify_Tree_For_C
and then In_Inlined_Body;
Legal : Boolean;
Pref_Id : Entity_Id;
@ -5339,7 +5341,7 @@ package body Sem_Attr is
if Chars (Spec_Id) = Name_uPostconditions
or else
(In_Inlined_C_Postcondition
and then Nkind (Parent (Spec_Id)) = N_Block_Statement)
and then Nkind (Parent (Spec_Id)) = N_Block_Statement)
then
Rewrite (N, Make_Identifier (Loc, Name_uResult));
@ -6136,149 +6138,150 @@ package body Sem_Attr is
-- Type_Key --
--------------
when Attribute_Type_Key =>
when Attribute_Type_Key => Type_Key : declare
Full_Name : constant String_Id :=
Fully_Qualified_Name_String (Entity (P));
CRC : CRC32;
-- The computed signature for the type
Deref : Boolean;
-- To simplify the handling of mutually recursive types, follow a
-- single dereference link in a composite type.
procedure Compute_Type_Key (T : Entity_Id);
-- Create a CRC integer from the declaration of the type, For a
-- composite type, fold in the representation of its components in
-- recursive fashion. We use directly the source representation of
-- the types involved.
----------------------
-- Compute_Type_Key --
----------------------
procedure Compute_Type_Key (T : Entity_Id) is
Buffer : Source_Buffer_Ptr;
P_Max : Source_Ptr;
P_Min : Source_Ptr;
Rep : Node_Id;
SFI : Source_File_Index;
procedure Process_One_Declaration;
-- Update CRC with the characters of one type declaration, or a
-- representation pragma that applies to the type.
-----------------------------
-- Process_One_Declaration --
-----------------------------
procedure Process_One_Declaration is
Ptr : Source_Ptr;
begin
Ptr := P_Min;
-- Scan type declaration, skipping blanks
while Ptr <= P_Max loop
if Buffer (Ptr) /= ' ' then
System.CRC32.Update (CRC, Buffer (Ptr));
end if;
Ptr := Ptr + 1;
end loop;
end Process_One_Declaration;
-- Start of processing for Compute_Type_Key
begin
if Is_Itype (T) then
return;
end if;
Sloc_Range (Enclosing_Declaration (T), P_Min, P_Max);
SFI := Get_Source_File_Index (P_Min);
Buffer := Source_Text (SFI);
Process_One_Declaration;
-- Recurse on relevant component types
if Is_Array_Type (T) then
Compute_Type_Key (Component_Type (T));
elsif Is_Access_Type (T) then
if not Deref then
Deref := True;
Compute_Type_Key (Designated_Type (T));
end if;
elsif Is_Derived_Type (T) then
Compute_Type_Key (Etype (T));
elsif Is_Record_Type (T) then
declare
Comp : Entity_Id;
begin
Comp := First_Component (T);
while Present (Comp) loop
Compute_Type_Key (Etype (Comp));
Next_Component (Comp);
end loop;
end;
end if;
-- Fold in representation aspects for the type, which appear in
-- the same source buffer.
Rep := First_Rep_Item (T);
while Present (Rep) loop
if Comes_From_Source (Rep) then
Sloc_Range (Rep, P_Min, P_Max);
Process_One_Declaration;
end if;
Rep := Next_Rep_Item (Rep);
end loop;
end Compute_Type_Key;
-- Start of processing for Type_Key
begin
Check_E0;
Check_Type;
declare
Full_Name : constant String_Id :=
Fully_Qualified_Name_String (Entity (P));
Start_String;
Deref := False;
Deref : Boolean;
-- To simplify the handling of mutually recursive types, follow
-- a single dereference link in a composite type.
-- Copy all characters in Full_Name but the trailing NUL
CRC : CRC32;
-- The computed signature for the type.
for J in 1 .. String_Length (Full_Name) - 1 loop
Store_String_Char (Get_String_Char (Full_Name, Pos (J)));
end loop;
procedure Compute_Type_Key (T : Entity_Id);
-- Create a CRC integer from the declaration of the type, For
-- a composite type, fold in the representation of its components
-- in recursive fashion. We use directly the source representation
-- of the types involved.
-- For standard type return the name of the type. as there is no
-- explicit source declaration to use. Otherwise compute CRC and
-- convert it to string one character at a time so as not to use
-- Image within the compiler.
--------------
-- Type_Key --
--------------
if Scope (Entity (P)) /= Standard_Standard then
Initialize (CRC);
Compute_Type_Key (Entity (P));
procedure Compute_Type_Key (T : Entity_Id) is
SFI : Source_File_Index;
Buffer : Source_Buffer_Ptr;
P_Min, P_Max : Source_Ptr;
Rep : Node_Id;
procedure Process_One_Declaration;
-- Update CRC with the characters of one type declaration,
-- or a representation pragma that applies to the type.
-----------------------------
-- Process_One_Declaration --
-----------------------------
procedure Process_One_Declaration is
Ptr : Source_Ptr;
begin
Ptr := P_Min;
-- Scan type declaration, skipping blanks,
while Ptr <= P_Max loop
if Buffer (Ptr) /= ' ' then
System.CRC32.Update (CRC, Buffer (Ptr));
end if;
Ptr := Ptr + 1;
end loop;
end Process_One_Declaration;
begin -- Start of processing for Compute_Type_Key
if Is_Itype (T) then
return;
end if;
Sloc_Range (Enclosing_Declaration (T), P_Min, P_Max);
SFI := Get_Source_File_Index (P_Min);
Buffer := Source_Text (SFI);
Process_One_Declaration;
-- Recurse on relevant component types.
if Is_Array_Type (T) then
Compute_Type_Key (Component_Type (T));
elsif Is_Access_Type (T) then
if not Deref then
Deref := True;
Compute_Type_Key (Designated_Type (T));
end if;
elsif Is_Derived_Type (T) then
Compute_Type_Key (Etype (T));
elsif Is_Record_Type (T) then
declare
Comp : Entity_Id;
begin
Comp := First_Component (T);
while Present (Comp) loop
Compute_Type_Key (Etype (Comp));
Next_Component (Comp);
end loop;
end;
end if;
-- Fold in representation aspects for the type, which
-- appear in the same source buffer.
Rep := First_Rep_Item (T);
while Present (Rep) loop
if Comes_From_Source (Rep) then
Sloc_Range (Rep, P_Min, P_Max);
Process_One_Declaration;
end if;
Rep := Next_Rep_Item (Rep);
end loop;
end Compute_Type_Key;
begin
Start_String;
Deref := False;
-- Copy all characters in Full_Name but the trailing NUL
for J in 1 .. String_Length (Full_Name) - 1 loop
Store_String_Char (Get_String_Char (Full_Name, Pos (J)));
end loop;
-- For standard type return the name of the type. as there is
-- no explicit source declaration to use. Otherwise compute
-- CRC and convert it to string one character at a time. so as
-- not to use Image within the compiler.
if Scope (Entity (P)) /= Standard_Standard then
Initialize (CRC);
Compute_Type_Key (Entity (P));
if not Is_Frozen (Entity (P)) then
Error_Msg_N ("premature usage of Type_Key?", N);
end if;
while CRC > 0 loop
Store_String_Char (Character'Val (48 + (CRC rem 10)));
CRC := CRC / 10;
end loop;
if not Is_Frozen (Entity (P)) then
Error_Msg_N ("premature usage of Type_Key?", N);
end if;
Rewrite (N, Make_String_Literal (Loc, End_String));
end;
while CRC > 0 loop
Store_String_Char (Character'Val (48 + (CRC rem 10)));
CRC := CRC / 10;
end loop;
end if;
Rewrite (N, Make_String_Literal (Loc, End_String));
Analyze_And_Resolve (N, Standard_String);
end Type_Key;
-----------------------
-- Unbiased_Rounding --

73
gcc/ada/sem_case.adb
View File

@ -455,51 +455,48 @@ package body Sem_Case is
----------------------
procedure Check_Duplicates is
Prev_Hi : Uint := Expr_Value (Choice_Table (1).Hi);
Choice : Node_Id;
Choice_Hi : Uint;
Choice_Lo : Uint;
Prev_Choice : Node_Id;
Prev_Hi : Uint;
begin
Prev_Hi := Expr_Value (Choice_Table (1).Hi);
for Outer_Index in 2 .. Num_Choices loop
declare
Choice_Lo : constant Uint :=
Expr_Value (Choice_Table (Outer_Index).Lo);
Choice_Hi : constant Uint :=
Expr_Value (Choice_Table (Outer_Index).Hi);
begin
if Choice_Lo <= Prev_Hi then
-- Choices overlap; this is an error
Choice_Lo := Expr_Value (Choice_Table (Outer_Index).Lo);
Choice_Hi := Expr_Value (Choice_Table (Outer_Index).Hi);
declare
Choice : constant Node_Id :=
Choice_Table (Outer_Index).Node;
Prev_Choice : Node_Id;
begin
-- Find first previous choice that overlaps
-- Choices overlap; this is an error
for Inner_Index in 1 .. Outer_Index - 1 loop
if Choice_Lo <=
Expr_Value (Choice_Table (Inner_Index).Hi)
then
Prev_Choice := Choice_Table (Inner_Index).Node;
exit;
end if;
end loop;
if Choice_Lo <= Prev_Hi then
Choice := Choice_Table (Outer_Index).Node;
if Sloc (Prev_Choice) <= Sloc (Choice) then
Error_Msg_Sloc := Sloc (Prev_Choice);
Dup_Choice
(Choice_Lo, UI_Min (Choice_Hi, Prev_Hi), Choice);
else
Error_Msg_Sloc := Sloc (Choice);
Dup_Choice
(Choice_Lo, UI_Min (Choice_Hi, Prev_Hi),
Prev_Choice);
end if;
end;
-- Find first previous choice that overlaps
for Inner_Index in 1 .. Outer_Index - 1 loop
if Choice_Lo <=
Expr_Value (Choice_Table (Inner_Index).Hi)
then
Prev_Choice := Choice_Table (Inner_Index).Node;
exit;
end if;
end loop;
if Sloc (Prev_Choice) <= Sloc (Choice) then
Error_Msg_Sloc := Sloc (Prev_Choice);
Dup_Choice (Choice_Lo, UI_Min (Choice_Hi, Prev_Hi), Choice);
else
Error_Msg_Sloc := Sloc (Choice);
Dup_Choice
(Choice_Lo, UI_Min (Choice_Hi, Prev_Hi), Prev_Choice);
end if;
end if;
if Choice_Hi > Prev_Hi then
Prev_Hi := Choice_Hi;
end if;
end;
if Choice_Hi > Prev_Hi then
Prev_Hi := Choice_Hi;
end if;
end loop;
end Check_Duplicates;

18
gcc/ada/sem_ch12.adb
View File

@ -8948,7 +8948,6 @@ package body Sem_Ch12 is
Gen_Body : Node_Id;
Gen_Decl : Node_Id)
is
function In_Same_Scope (Gen_Id, Act_Id : Node_Id) return Boolean;
-- Check if the generic definition and the instantiation come from
-- a common scope, in which case the instance must be frozen after
@ -8990,12 +8989,12 @@ package body Sem_Ch12 is
---------------
function True_Sloc (N, Act_Unit : Node_Id) return Source_Ptr is
Res : Source_Ptr;
N1 : Node_Id;
Res : Source_Ptr;
begin
Res := Sloc (N);
N1 := N;
N1 := N;
while Present (N1) and then N1 /= Act_Unit loop
if Sloc (N1) > Res then
Res := Sloc (N1);
@ -9013,11 +9012,11 @@ package body Sem_Ch12 is
Par : constant Entity_Id := Scope (Gen_Id);
Gen_Unit : constant Node_Id :=
Unit (Cunit (Get_Source_Unit (Gen_Decl)));
Orig_Body : Node_Id := Gen_Body;
F_Node : Node_Id;
Body_Unit : Node_Id;
Body_Unit : Node_Id;
F_Node : Node_Id;
Must_Delay : Boolean;
Orig_Body : Node_Id := Gen_Body;
-- Start of processing for Install_Body
@ -9080,13 +9079,13 @@ package body Sem_Ch12 is
Must_Delay :=
(Gen_Unit = Act_Unit
and then (Nkind_In (Gen_Unit, N_Package_Declaration,
N_Generic_Package_Declaration)
and then (Nkind_In (Gen_Unit, N_Generic_Package_Declaration,
N_Package_Declaration)
or else (Gen_Unit = Body_Unit
and then True_Sloc (N, Act_Unit)
< Sloc (Orig_Body)))
and then Is_In_Main_Unit (Original_Node (Gen_Unit))
and then (In_Same_Scope (Gen_Id, Act_Id)));
and then In_Same_Scope (Gen_Id, Act_Id));
-- If this is an early instantiation, the freeze node is placed after
-- the generic body. Otherwise, if the generic appears in an instance,
@ -12914,7 +12913,6 @@ package body Sem_Ch12 is
end if;
Current_Unit := Parent (N);
while Present (Current_Unit)
and then Nkind (Current_Unit) /= N_Compilation_Unit
loop

7
gcc/ada/sem_ch3.adb
View File

@ -877,6 +877,7 @@ package body Sem_Ch3 is
then
Build_Itype_Reference (Anon_Type, Parent (Current_Scope));
end if;
return Anon_Type;
end if;
@ -14758,9 +14759,9 @@ package body Sem_Ch3 is
or else Is_Private_Overriding
or else Is_Internal_Name (Chars (Parent_Subp))
or else (Is_Controlled (Parent_Type)
and then Nam_In (Chars (Parent_Subp), Name_Initialize,
Name_Adjust,
Name_Finalize))
and then Nam_In (Chars (Parent_Subp), Name_Adjust,
Name_Finalize,
Name_Initialize))
then
Set_Derived_Name;

8
gcc/ada/sem_ch4.adb
View File

@ -4804,6 +4804,7 @@ package body Sem_Ch4 is
In_Scope := In_Open_Scopes (Prefix_Type);
while Present (Comp) loop
-- Do not examine private operations of the type if not within
-- its scope.
@ -4821,10 +4822,9 @@ package body Sem_Ch4 is
-- a visible entity is found.
if Is_Tagged_Type (Prefix_Type)
and then
Nkind_In (Parent (N), N_Procedure_Call_Statement,
N_Function_Call,
N_Indexed_Component)
and then Nkind_In (Parent (N), N_Function_Call,
N_Indexed_Component,
N_Procedure_Call_Statement)
and then Has_Mode_Conformant_Spec (Comp)
then
Has_Candidate := True;

8
gcc/ada/sem_prag.adb
View File

@ -26411,9 +26411,6 @@ package body Sem_Prag is
Par_Subp : Entity_Id;
Adjust_Sloc : Boolean)
is
Par_Formal : Entity_Id;
Subp_Formal : Entity_Id;
function Replace_Entity (N : Node_Id) return Traverse_Result;
-- Replace reference to formal of inherited operation or to primitive
-- operation of root type, with corresponding entity for derived type,
@ -26516,6 +26513,11 @@ package body Sem_Prag is
procedure Replace_Condition_Entities is
new Traverse_Proc (Replace_Entity);
-- Local variables
Par_Formal : Entity_Id;
Subp_Formal : Entity_Id;
-- Start of processing for Build_Class_Wide_Expression
begin

2
gcc/ada/xref_lib.adb
View File

@ -645,7 +645,7 @@ package body Xref_Lib is
declare
Table : Table_Type renames
File.Dep.Table (1 .. Last (File.Dep));
File.Dep.Table (1 .. Last (File.Dep));
begin
Table (Num_Dependencies) := Add_To_Xref_File
(Ali (File_Start .. File_End),