+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
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)
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;
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);
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;
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
-- 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));
-- 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;
Name => Name (N),
Rec => Rec,
External => False);
-
end if;
-- Analyze and resolve the new call. The actuals have already been
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;
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;
-- 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);
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);
-- 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);
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;
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);
when None =>
null;
end case;
-
end Copy_To;
-- Start of processing for Copy_File
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);
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
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);
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;
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;
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
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);
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;
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;
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;
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;
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;
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;
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;
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
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;
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;
-- 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;
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));
-- Type_Key --
--------------
- when Attribute_Type_Key =>
- Check_E0;
- Check_Type;
-
- declare
- Full_Name : constant String_Id :=
- Fully_Qualified_Name_String (Entity (P));
+ when Attribute_Type_Key => Type_Key : declare
+ Full_Name : constant String_Id :=
+ Fully_Qualified_Name_String (Entity (P));
- Deref : Boolean;
- -- To simplify the handling of mutually recursive types, follow
- -- a single dereference link in a composite type.
+ CRC : CRC32;
+ -- The computed signature for the type
- 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.
+ 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.
- --------------
- -- Type_Key --
- --------------
+ ----------------------
+ -- Compute_Type_Key --
+ ----------------------
- 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 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.
+ 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 --
- -----------------------------
+ -----------------------------
+ -- Process_One_Declaration --
+ -----------------------------
- procedure Process_One_Declaration is
- Ptr : Source_Ptr;
+ procedure Process_One_Declaration is
+ Ptr : Source_Ptr;
- begin
- Ptr := P_Min;
+ begin
+ Ptr := P_Min;
- -- Scan type declaration, skipping blanks,
+ -- Scan type declaration, skipping blanks
- while Ptr <= P_Max loop
- if Buffer (Ptr) /= ' ' then
- System.CRC32.Update (CRC, Buffer (Ptr));
- end if;
+ 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;
+ Ptr := Ptr + 1;
+ end loop;
+ end Process_One_Declaration;
- begin -- Start of processing for Compute_Type_Key
+ -- Start of processing for Compute_Type_Key
- if Is_Itype (T) then
- return;
- end if;
+ 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);
+ Sloc_Range (Enclosing_Declaration (T), P_Min, P_Max);
+ SFI := Get_Source_File_Index (P_Min);
+ Buffer := Source_Text (SFI);
- Process_One_Declaration;
+ Process_One_Declaration;
- -- Recurse on relevant component types.
+ -- Recurse on relevant component types
- if Is_Array_Type (T) then
- Compute_Type_Key (Component_Type (T));
+ 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_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_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));
+ 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;
- Next_Component (Comp);
- end loop;
- end;
- end if;
+ -- Fold in representation aspects for the type, which appear in
+ -- the same source buffer.
- -- Fold in representation aspects for the type, which
- -- appear in the same source buffer.
+ Rep := First_Rep_Item (T);
- 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;
- 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;
- Rep := Next_Rep_Item (Rep);
- end loop;
- end Compute_Type_Key;
+ -- Start of processing for Type_Key
- begin
- Start_String;
- Deref := False;
+ begin
+ Check_E0;
+ Check_Type;
- -- Copy all characters in Full_Name but the trailing NUL
+ Start_String;
+ Deref := False;
- for J in 1 .. String_Length (Full_Name) - 1 loop
- Store_String_Char (Get_String_Char (Full_Name, Pos (J)));
- end loop;
+ -- Copy all characters in Full_Name but the trailing NUL
- -- 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.
+ for J in 1 .. String_Length (Full_Name) - 1 loop
+ Store_String_Char (Get_String_Char (Full_Name, Pos (J)));
+ end loop;
- if Scope (Entity (P)) /= Standard_Standard then
- Initialize (CRC);
- Compute_Type_Key (Entity (P));
+ -- 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 not Is_Frozen (Entity (P)) then
- Error_Msg_N ("premature usage of Type_Key?", N);
- end if;
+ if Scope (Entity (P)) /= Standard_Standard then
+ Initialize (CRC);
+ Compute_Type_Key (Entity (P));
- 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 --
----------------------
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
-
- declare
- Choice : constant Node_Id :=
- Choice_Table (Outer_Index).Node;
- Prev_Choice : Node_Id;
- begin
- -- 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;
+ Choice_Lo := Expr_Value (Choice_Table (Outer_Index).Lo);
+ Choice_Hi := Expr_Value (Choice_Table (Outer_Index).Hi);
- 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;
- end if;
+ -- Choices overlap; this is an error
- if Choice_Hi > Prev_Hi then
- Prev_Hi := Choice_Hi;
+ if Choice_Lo <= Prev_Hi then
+ Choice := Choice_Table (Outer_Index).Node;
+
+ -- 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;
+ end if;
+
+ if Choice_Hi > Prev_Hi then
+ Prev_Hi := Choice_Hi;
+ end if;
end loop;
end Check_Duplicates;
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
---------------
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);
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
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,
end if;
Current_Unit := Parent (N);
-
while Present (Current_Unit)
and then Nkind (Current_Unit) /= N_Compilation_Unit
loop
then
Build_Itype_Reference (Anon_Type, Parent (Current_Scope));
end if;
+
return Anon_Type;
end if;
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;
In_Scope := In_Open_Scopes (Prefix_Type);
while Present (Comp) loop
+
-- Do not examine private operations of the type if not within
-- its scope.
-- 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;
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,
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
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),
projects / gcc.git / commitdiff