-----------------------------------
function Internal_Traverse_With_Parent
- (Node : Node_Id) return Traverse_Final_Result
+ (Node : Node_Id) return Traverse_Final_Result
is
Tail_Recursion_Counter : Natural := 0;
(Intersecting_Labels : Labeled_Span_List);
function Get_Line_End
- (Buf : Source_Buffer_Ptr;
- Loc : Source_Ptr) return Source_Ptr;
+ (Buf : Source_Buffer_Ptr;
+ Loc : Source_Ptr) return Source_Ptr;
-- Get the source location for the end of the line (LF) in Buf for Loc. If
-- Loc is past the end of Buf already, return Buf'Last.
function Get_Line_Start
- (Buf : Source_Buffer_Ptr;
- Loc : Source_Ptr) return Source_Ptr;
+ (Buf : Source_Buffer_Ptr;
+ Loc : Source_Ptr) return Source_Ptr;
-- Get the source location for the start of the line in Buf for Loc
function Get_First_Line_Char
-- Width digits.
procedure Write_Buffer
- (Buf : Source_Buffer_Ptr;
- First : Source_Ptr;
- Last : Source_Ptr);
+ (Buf : Source_Buffer_Ptr;
+ First : Source_Ptr;
+ Last : Source_Ptr);
-- Output the characters from First to Last position in Buf, using
-- Write_Buffer_Char.
procedure Write_Buffer_Char
- (Buf : Source_Buffer_Ptr;
- Loc : Source_Ptr);
+ (Buf : Source_Buffer_Ptr;
+ Loc : Source_Ptr);
-- Output the characters at position Loc in Buf, translating ASCII.HT
-- in a suitable number of spaces so that the output is not modified
-- by starting in a different column that 1.
procedure Write_Line_Marker
- (Num : Pos;
- Width : Positive);
+ (Num : Pos;
+ Width : Positive);
procedure Write_Empty_Bar_Line (Width : Integer);
-----------------------
procedure Write_Buffer_Char
- (Buf : Source_Buffer_Ptr;
- Loc : Source_Ptr)
+ (Buf : Source_Buffer_Ptr;
+ Loc : Source_Ptr)
is
begin
-- If the character ASCII.HT is not the last one in the file,
-----------------------
procedure Write_Line_Marker
- (Num : Pos;
- Width : Positive)
+ (Num : Pos;
+ Width : Positive)
is
begin
Write_Str (Image (Positive (Num), Width => Width - 2));
begin
if Warning_Doc_Switch
and then Diag.Kind in Default_Warning
- | Info
- | Restriction_Warning
- | Style
- | Warning
+ | Info
+ | Restriction_Warning
+ | Style
+ | Warning
then
if Diag.Switch = No_Switch_Id then
if Diag.Kind = Restriction_Warning then
function Get_Class_Wide_Pragma
(E : Entity_Id;
Id : Pragma_Id) return Node_Id
- is
+ is
Item : Node_Id;
Items : Node_Id;
end;
when Access_Kind =>
- Write_Attribute
- (" Directly Designated Type ",
- Directly_Designated_Type (Id));
- Write_Eol;
+ Write_Attribute
+ (" Directly Designated Type ",
+ Directly_Designated_Type (Id));
+ Write_Eol;
when Overloadable_Kind =>
if Present (Homonym (Id)) then
end Error_Msg;
procedure Error_Msg
- (Msg : String;
- Flag_Location : Source_Ptr;
- N : Node_Id;
- Is_Compile_Time_Pragma : Boolean)
+ (Msg : String;
+ Flag_Location : Source_Ptr;
+ N : Node_Id;
+ Is_Compile_Time_Pragma : Boolean)
is
Save_Is_Compile_Time_Msg : constant Boolean := Is_Compile_Time_Msg;
begin
Comp_Typ : Node_Id;
Init_Expr : Node_Id;
Stmts : List_Id);
- -- Perform the initialization of component Comp with expected type
- -- Comp_Typ of aggregate N. Init_Expr denotes the initialization
- -- expression of the component. All generated code is added to Stmts.
+ -- Perform the initialization of component Comp with expected type
+ -- Comp_Typ of aggregate N. Init_Expr denotes the initialization
+ -- expression of the component. All generated code is added to Stmts.
function Is_Static_Dispatch_Table_Aggregate (N : Node_Id) return Boolean;
-- Returns true if N is an aggregate used to initialize the components
function Get_Assoc_Expr (Assoc : Node_Id) return Node_Id;
-- For an association with a box, use value given by aspect
- -- Default_Component_Value of array type if specified, else use
- -- value given by aspect Default_Value for component type itself
- -- if specified, else return Empty.
+ -- Default_Component_Value of array type if specified, else use
+ -- value given by aspect Default_Value for component type itself
+ -- if specified, else return Empty.
function Local_Compile_Time_Known_Value (E : Node_Id) return Boolean;
function Local_Expr_Value (E : Node_Id) return Uint;
function Gen_Assign
(Ind : Node_Id;
Expr : Node_Id) return List_Id
- is
+ is
function Add_Loop_Actions (Lis : List_Id) return List_Id;
-- Collect insert_actions generated in the construction of a loop,
-- and prepend them to the sequence of assignments to complete the
Constraints =>
New_List (Make_Range (Loc, Aggr_Lo, Aggr_Hi)))));
- -- Create a temporary array of the above subtype which
- -- will be used to capture the aggregate assignments.
+ -- Create a temporary array of the above subtype which
+ -- will be used to capture the aggregate assignments.
- TmpD : constant Node_Id :=
- Make_Object_Declaration (Loc,
- Defining_Identifier => TmpE,
- Object_Definition => New_Occurrence_Of (SubE, Loc));
+ TmpD : constant Node_Id :=
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => TmpE,
+ Object_Definition => New_Occurrence_Of (SubE, Loc));
begin
Insert_Actions (N, New_List (SubD, TmpD));
Build_Record_Init_Proc (Typ_Decl, Typ);
end if;
- -- Create the body of TSS primitive Finalize_Address. This must be done
- -- before the bodies of all predefined primitives are created. If Typ
- -- is limited, Stream_Input and Stream_Read may produce build-in-place
- -- allocations and for those the expander needs Finalize_Address.
+ -- Create the body of TSS primitive Finalize_Address. This must be done
+ -- before the bodies of all predefined primitives are created. If Typ
+ -- is limited, Stream_Input and Stream_Read may produce build-in-place
+ -- allocations and for those the expander needs Finalize_Address.
if Is_Controlled (Typ) then
Make_Finalize_Address_Body (Typ);
Else_Statements => New_List (Guard_Except));
- -- If a separate initialization assignment was created
- -- earlier, append that following the assignment of the
- -- implicit access formal to the access object, to ensure
- -- that the return object is initialized in that case. In
- -- this situation, the target of the assignment must be
- -- rewritten to denote a dereference of the access to the
- -- return object passed in by the caller.
-
- if Present (Init_Stmt) then
- Set_Name (Init_Stmt,
- Make_Explicit_Dereference (Loc,
- Prefix => New_Occurrence_Of (Alloc_Obj_Id, Loc)));
- Set_Assignment_OK (Name (Init_Stmt));
-
- Append_To (Then_Statements (Alloc_Stmt), Init_Stmt);
- Init_Stmt := Empty;
- end if;
+ -- If a separate initialization assignment was created
+ -- earlier, append that following the assignment of the
+ -- implicit access formal to the access object, to ensure
+ -- that the return object is initialized in that case. In
+ -- this situation, the target of the assignment must be
+ -- rewritten to denote a dereference of the access to the
+ -- return object passed in by the caller.
+
+ if Present (Init_Stmt) then
+ Set_Name (Init_Stmt,
+ Make_Explicit_Dereference (Loc,
+ Prefix => New_Occurrence_Of (Alloc_Obj_Id, Loc)));
+ Set_Assignment_OK (Name (Init_Stmt));
+
+ Append_To (Then_Statements (Alloc_Stmt), Init_Stmt);
+ Init_Stmt := Empty;
+ end if;
Insert_Action (N, Alloc_Stmt, Suppress => All_Checks);
elsif Restriction_Active (No_Implicit_Conditionals) then
declare
- T : constant Entity_Id :=
- Make_Defining_Identifier (Loc, Chars => Name_T);
+ T : constant Entity_Id :=
+ Make_Defining_Identifier (Loc, Chars => Name_T);
begin
Rewrite (N,
-- -- formals; therefore Is_Build_In_Place_Function_Call returns False.
procedure Replace_Renaming_Declaration_Id
- (New_Decl : Node_Id;
- Orig_Decl : Node_Id);
+ (New_Decl : Node_Id;
+ Orig_Decl : Node_Id);
-- Replace the internal identifier of the new renaming declaration New_Decl
-- with the identifier of its original declaration Orig_Decl exchanging the
-- entities containing their defining identifiers to ensure the correct
-------------------------------------
procedure Replace_Renaming_Declaration_Id
- (New_Decl : Node_Id;
- Orig_Decl : Node_Id)
+ (New_Decl : Node_Id;
+ Orig_Decl : Node_Id)
is
New_Id : constant Entity_Id := Defining_Entity (New_Decl);
Orig_Id : constant Entity_Id := Defining_Entity (Orig_Decl);
when N_Entry_Call_Statement
| N_Procedure_Call_Statement
| N_Function_Call
- =>
+ =>
declare
Call_Node : Node_Id renames Nod;
Subp : Entity_Id;
when N_Procedure_Specification
| N_Function_Specification
- =>
+ =>
return Skip;
when N_Abstract_Subprogram_Declaration
| N_Use_Package_Clause
| N_Use_Type_Clause
| N_With_Clause
- =>
+ =>
return Skip;
when others =>
else Empty);
function Build_BIP_Cleanup_Stmts
- (Func_Id : Entity_Id;
- Obj_Addr : Node_Id) return Node_Id;
+ (Func_Id : Entity_Id;
+ Obj_Addr : Node_Id) return Node_Id;
-- Func_Id denotes a build-in-place function. Generate the following
-- cleanup code:
--
Set_Scope (Id, Block_Elab_Proc);
when N_Object_Declaration
- | N_Object_Renaming_Declaration =>
+ | N_Object_Renaming_Declaration
+ =>
Id := Defining_Entity (Stat);
if No (Block_Elab_Proc) then
Append_Elmt (Id, Maybe_Reset_Scopes_For_Decl);
Right_Opnd => New_Occurrence_Of (J, Loc))),
Right_Opnd => Make_Integer_Literal (Loc, Int (L1)))));
- -- Generate loop
+ -- Generate loop
Body_Stmts := New_List (
Make_Implicit_Loop_Statement (N,
-- This expression includes any required range checks.
function Compute_Number_Components
- (N : Node_Id;
- Typ : Entity_Id) return Node_Id;
+ (N : Node_Id;
+ Typ : Entity_Id) return Node_Id;
-- Build an expression that multiplies the length of the dimensions of the
-- array, used to control array equality checks.
-------------------------------
function Compute_Number_Components
- (N : Node_Id;
- Typ : Entity_Id) return Node_Id
+ (N : Node_Id;
+ Typ : Entity_Id) return Node_Id
is
Loc : constant Source_Ptr := Sloc (N);
Len_Expr : Node_Id;
-- type.
function Get_Nth_Arg_Type
- (Subprogram : Entity_Id;
- N : Positive) return Entity_Id;
+ (Subprogram : Entity_Id;
+ N : Positive) return Entity_Id;
-- Returns the type of the Nth argument of Subprogram
function To_Addresses (Elmts : Elist_Id) return List_Id;
----------------------
function Get_Nth_Arg_Type
- (Subprogram : Entity_Id;
- N : Positive) return Entity_Id
+ (Subprogram : Entity_Id;
+ N : Positive) return Entity_Id
is
Argument : Entity_Id := First_Entity (Subprogram);
begin
end;
end if;
- -- A selected component can have an implicit up-level
- -- reference due to the bounds of previous fields in the
- -- record. We simplify the processing here by examining
- -- all components of the record.
-
- -- Selected components appear as unit names and end labels
- -- for child units. Prefixes of these nodes denote parent
- -- units and carry no type information so they are skipped.
+ -- A selected component can have an implicit up-level
+ -- reference due to the bounds of previous fields in the
+ -- record. We simplify the processing here by examining
+ -- all components of the record.
+
+ -- Selected components appear as unit names and end labels
+ -- for child units. Prefixes of these nodes denote parent
+ -- units and carry no type information so they are skipped.
when N_Selected_Component =>
if Present (Etype (Prefix (N))) then
-- function body that computes image.
procedure Build_Task_Image_Prefix
- (Loc : Source_Ptr;
- Len : out Entity_Id;
- Res : out Entity_Id;
- Pos : out Entity_Id;
- Prefix : Entity_Id;
- Sum : Node_Id;
- Decls : List_Id;
- Stats : List_Id);
+ (Loc : Source_Ptr;
+ Len : out Entity_Id;
+ Res : out Entity_Id;
+ Pos : out Entity_Id;
+ Prefix : Entity_Id;
+ Sum : Node_Id;
+ Decls : List_Id;
+ Stats : List_Id);
-- Common processing for Task_Array_Image and Task_Record_Image. Create
-- local variables and assign prefix of name to result string.
-----------------------------
procedure Build_Task_Image_Prefix
- (Loc : Source_Ptr;
- Len : out Entity_Id;
- Res : out Entity_Id;
- Pos : out Entity_Id;
- Prefix : Entity_Id;
- Sum : Node_Id;
- Decls : List_Id;
- Stats : List_Id)
+ (Loc : Source_Ptr;
+ Len : out Entity_Id;
+ Res : out Entity_Id;
+ Pos : out Entity_Id;
+ Prefix : Entity_Id;
+ Sum : Node_Id;
+ Decls : List_Id;
+ Stats : List_Id)
is
begin
Len := Make_Temporary (Loc, 'L', Sum);
-- type T identifies T.
when N_Indexed_Component
- | N_Selected_Component
- | N_Aggregate
- | N_Extension_Aggregate
+ | N_Selected_Component
+ | N_Aggregate
+ | N_Extension_Aggregate
=>
return True;
return Nkind (N) in N_Type_Conversion | N_Unchecked_Type_Conversion
or else (Nkind (N) = N_Explicit_Dereference
and then Nkind (Prefix (N)) in N_Type_Conversion
- | N_Unchecked_Type_Conversion)
+ | N_Unchecked_Type_Conversion)
or else (Is_Entity_Name (N)
and then Present (Entity (N))
and then Is_Formal (Entity (N)));
--------------------------------------------------
function Is_Expanded_Class_Wide_Interface_Object_Decl
- (N : Node_Id) return Boolean is
+ (N : Node_Id) return Boolean is
begin
return not Comes_From_Source (N)
and then Nkind (Original_Node (N)) = N_Object_Declaration
end;
end Write_Unit;
- procedure Check_Version_And_Help is new Check_Version_And_Help_G (Usage);
+ procedure Check_Version_And_Help is new Check_Version_And_Help_G (Usage);
-- Start of processing for gnatchop
begin
Path (1 .. File_Path'Length) := File_Path.all;
- -- To find the location of the shared version of libgcc, we
- -- look for "gcc-lib" in the path of the library. However,
- -- this subdirectory is no longer present in recent versions
- -- of GCC. So, we look for the last subdirectory "lib" in
- -- the path.
+ -- To find the location of the shared version of libgcc,
+ -- we look for "gcc-lib" in the path of the
+ -- library. However, this subdirectory is no longer
+ -- present in recent versions of GCC. So, we look for the
+ -- last subdirectory "lib" in the path.
GCC_Index := Index (Path (1 .. Path_Last), "gcc-lib");
end if;
end if;
- -- Look for an eventual run_path_option in
- -- the linker switches.
+ -- Look for an eventual run_path_option in
+ -- the linker switches.
if Separate_Run_Path_Options then
Linker_Options.Increment_Last;
begin
for J in FN'Range loop
- FN (J) := Csets.Fold_Lower (FN (J));
+ FN (J) := Csets.Fold_Lower (FN (J));
end loop;
-- For now we detect Windows by its executable suffix of .exe
-------------------------------------------
function Call_Can_Be_Inlined_In_GNATprove_Mode
- (N : Node_Id;
- Subp : Entity_Id) return Boolean
+ (N : Node_Id;
+ Subp : Entity_Id) return Boolean
is
function Has_Dereference (N : Node_Id) return Boolean;
-- Return whether N contains an explicit dereference
-------------------------
procedure Expand_Inlined_Call
- (N : Node_Id;
- Subp : Entity_Id;
- Orig_Subp : Entity_Id)
+ (N : Node_Id;
+ Subp : Entity_Id;
+ Orig_Subp : Entity_Id)
is
Decls : constant List_Id := New_List;
Is_Predef : constant Boolean :=
---------------------------------
function Create_Null_Excluding_Itype
- (T : Entity_Id;
- Related_Nod : Node_Id;
- Scope_Id : Entity_Id := Current_Scope) return Entity_Id
+ (T : Entity_Id;
+ Related_Nod : Node_Id;
+ Scope_Id : Entity_Id := Current_Scope) return Entity_Id
is
I_Typ : Entity_Id;
when Binder
| Gnatls
- =>
+ =>
Dir_Name := Normalize_Directory_Name (Dir_Name.all);
Lib_Search_Directories.Table (Primary_Directory) := Dir_Name;
end if;
exception
- -- Generate error message if run-time unit not available
+ -- Generate error message if run-time unit not available
when RE_Not_Available =>
Error_Msg_N ("& not available", Nam);
declare
In_Assoc : constant Boolean :=
Nkind (Parent (Expr)) in N_Component_Association
- | N_Iterated_Component_Association;
+ | N_Iterated_Component_Association;
New_Expr : constant Node_Id := Copy_Separate_Tree (Expr);
begin
procedure Resolve_Container_Aggregate (N : Node_Id; Typ : Entity_Id) is
procedure Resolve_Iterated_Association
- (Comp : Node_Id;
- Key_Type : Entity_Id;
- Elmt_Type : Entity_Id);
+ (Comp : Node_Id;
+ Key_Type : Entity_Id;
+ Elmt_Type : Entity_Id);
-- Resolve choices and expression in an iterated component association
-- or an iterated element association, which has a key_expression.
-- This is similar but not identical to the handling of this construct
----------------------------------
procedure Resolve_Iterated_Association
- (Comp : Node_Id;
- Key_Type : Entity_Id;
- Elmt_Type : Entity_Id)
+ (Comp : Node_Id;
+ Key_Type : Entity_Id;
+ Elmt_Type : Entity_Id)
is
Loc : constant Source_Ptr := Sloc (N);
Choice : Node_Id;
Clause : Node_Id;
procedure Process_Body_Clauses
- (Context_List : List_Id;
- Clause : Node_Id;
- Used : out Boolean;
- Used_Type_Or_Elab : out Boolean);
+ (Context_List : List_Id;
+ Clause : Node_Id;
+ Used : out Boolean;
+ Used_Type_Or_Elab : out Boolean);
-- Examine the context clauses of a package body, trying to match the
-- name entity of Clause with any list element. If the match occurs
-- on a use package clause set Used to True, for a use type clause or
-- pragma Elaborate[_All], set Used_Type_Or_Elab to True.
procedure Process_Spec_Clauses
- (Context_List : List_Id;
- Clause : Node_Id;
- Used : out Boolean;
- Withed : out Boolean;
- Exit_On_Self : Boolean);
+ (Context_List : List_Id;
+ Clause : Node_Id;
+ Used : out Boolean;
+ Withed : out Boolean;
+ Exit_On_Self : Boolean);
-- Examine the context clauses of a package spec, trying to match
-- the name entity of Clause with any list element. If the match
-- occurs on a use package clause, set Used to True, for a with
--------------------------
procedure Process_Body_Clauses
- (Context_List : List_Id;
- Clause : Node_Id;
- Used : out Boolean;
- Used_Type_Or_Elab : out Boolean)
+ (Context_List : List_Id;
+ Clause : Node_Id;
+ Used : out Boolean;
+ Used_Type_Or_Elab : out Boolean)
is
Nam_Ent : constant Entity_Id := Entity (Name (Clause));
Cont_Item : Node_Id;
--------------------------
procedure Process_Spec_Clauses
- (Context_List : List_Id;
- Clause : Node_Id;
- Used : out Boolean;
- Withed : out Boolean;
- Exit_On_Self : Boolean)
+ (Context_List : List_Id;
+ Clause : Node_Id;
+ Used : out Boolean;
+ Withed : out Boolean;
+ Exit_On_Self : Boolean)
is
Nam_Ent : constant Entity_Id := Entity (Name (Clause));
Cont_Item : Node_Id;
| N_Formal_Package_Declaration
| N_Use_Package_Clause
| N_Use_Type_Clause
- =>
+ =>
Action (F, Index);
Index := Index + 1;
when N_Pragma =>
| N_Full_Type_Declaration
| N_Private_Type_Declaration
| N_Private_Extension_Declaration
- =>
+ =>
if Is_Internal_Name (Chars (Defining_Entity (F))) then
null;
else
Infer_From_Access (Gen_Assocs, Index, F, A_Full);
when E_Access_Subtype
- | E_Access_Attribute_Type
- | E_Allocator_Type
- | E_Anonymous_Access_Type =>
+ | E_Access_Attribute_Type
+ | E_Allocator_Type
+ | E_Anonymous_Access_Type
+ =>
raise Program_Error;
when E_Array_Type | E_Array_Subtype =>
-----------------------------------
procedure Analyze_Formal_Interface_Type
- (N : Node_Id;
- T : Entity_Id;
- Def : Node_Id)
+ (N : Node_Id;
+ T : Entity_Id;
+ Def : Node_Id)
is
Loc : constant Source_Ptr := Sloc (N);
New_N : Node_Id;
(N : Node_Id;
Gen_Body : Node_Id;
Pack_Id : Entity_Id)
- is
+ is
function Enclosing_Package_Body (N : Node_Id) return Node_Id;
-- Find innermost package body that encloses the given node, and which
-- is not a compilation unit. Freeze nodes for the instance, or for its
Parent_Spec : Node_Id;
procedure Find_Matching_Actual
- (F : Node_Id;
- Act : in out Entity_Id);
+ (F : Node_Id;
+ Act : in out Entity_Id);
-- We need to associate each formal entity in the formal package with
-- the corresponding entity in the actual package. The actual package
-- has been analyzed and possibly expanded, and as a result there is
procedure Find_Matching_Actual
(F : Node_Id;
Act : in out Entity_Id)
- is
+ is
Formal_Ent : Entity_Id;
begin
-- the expression of aspect Asp evaluates to False or is erroneous.
function Build_Predicate_Function_Declaration
- (Typ : Entity_Id) return Node_Id;
+ (Typ : Entity_Id) return Node_Id;
-- Build the declaration for a predicate function. The declaration is built
-- at the same time as the body but inserted before, as explained below.
-- or to have the proper profile (when a subprogram).
procedure Resolve_Aspect_Stable_Properties
- (Typ_Or_Subp : Entity_Id;
- Expr : Node_Id;
- Class_Present : Boolean);
+ (Typ_Or_Subp : Entity_Id;
+ Expr : Node_Id;
+ Class_Present : Boolean);
-- Resolve each one of the functions specified in the specification of
-- aspect Stable_Properties (or Stable_Properties'Class).
when N_Op_Not =>
return not Get_RList (Right_Opnd (Exp), Static);
- -- Comparisons of type with static value
+ -- Comparisons of type with static value
when N_Op_Compare =>
-- Predicate_Function (T) is non-empty.
procedure Replace_Current_Instance_References
- (N : Node_Id; Typ, New_Entity : Entity_Id);
+ (N : Node_Id; Typ, New_Entity : Entity_Id);
-- Replace all references to Typ in the tree rooted at N with
-- references to Param. [New_Entity will be a formal parameter of a
-- predicate function.]
-----------------------------------------
procedure Replace_Current_Instance_References
- (N : Node_Id; Typ, New_Entity : Entity_Id)
+ (N : Node_Id; Typ, New_Entity : Entity_Id)
is
Root : Node_Id renames N;
------------------------------
procedure Resolve_Aspect_Aggregate
- (Typ : Entity_Id;
- Expr : Node_Id)
+ (Typ : Entity_Id;
+ Expr : Node_Id)
is
function Valid_Empty (E : Entity_Id) return Boolean;
function Valid_Add_Named (E : Entity_Id) return Boolean;
--------------------------------------
procedure Resolve_Aspect_Stable_Properties
- (Typ_Or_Subp : Entity_Id; Expr : Node_Id; Class_Present : Boolean)
+ (Typ_Or_Subp : Entity_Id; Expr : Node_Id; Class_Present : Boolean)
is
Is_Aspect_Of_Type : constant Boolean := Is_Type (Typ_Or_Subp);
goto Continue;
end if;
- -- Don't do the check if warnings off for either type, note the
- -- deliberate use of OR here instead of OR ELSE to get the flag
- -- Warnings_Off_Used set for both types if appropriate.
+ -- Don't do the check if warnings off for either type, note the
+ -- deliberate use of OR here instead of OR ELSE to get the flag
+ -- Warnings_Off_Used set for both types if appropriate.
if Has_Warnings_Off (Source) or Has_Warnings_Off (Target) then
goto Continue;
with Lib; use Lib;
with Lib.Writ;
with Lib.Xref; use Lib.Xref;
-with Mutably_Tagged; use Mutably_Tagged;
+with Mutably_Tagged; use Mutably_Tagged;
with Namet; use Namet;
with Nlists; use Nlists;
with Nmake; use Nmake;
-- D within the discriminant list of the discriminated type T.
procedure Process_Discriminant_Expression
- (Expr : Node_Id;
- D : Entity_Id);
+ (Expr : Node_Id;
+ D : Entity_Id);
-- If this is a discriminant constraint on a partial view, do not
-- generate an overflow check on the discriminant expression. The check
-- will be generated when constraining the full view. Otherwise the
-------------------------------------
procedure Process_Discriminant_Expression
- (Expr : Node_Id;
- D : Entity_Id)
+ (Expr : Node_Id;
+ D : Entity_Id)
is
BDT : constant Entity_Id := Base_Type (Etype (D));
-- the operand of the operator node.
procedure Analyze_One_Call
- (N : Node_Id;
- Nam : Entity_Id;
- Report : Boolean;
- Success : out Boolean;
- Skip_First : Boolean := False);
+ (N : Node_Id;
+ Nam : Entity_Id;
+ Report : Boolean;
+ Success : out Boolean;
+ Skip_First : Boolean := False);
-- Check one interpretation of an overloaded subprogram name for
-- compatibility with the types of the actuals in a call. If there is a
-- single interpretation which does not match, post error if Report is
----------------------
procedure Analyze_One_Call
- (N : Node_Id;
- Nam : Entity_Id;
- Report : Boolean;
- Success : out Boolean;
- Skip_First : Boolean := False)
+ (N : Node_Id;
+ Nam : Entity_Id;
+ Report : Boolean;
+ Success : out Boolean;
+ Skip_First : Boolean := False)
is
Actuals : constant List_Id := Parameter_Associations (N);
Prev_T : constant Entity_Id := Etype (N);
-- Return the dimension vector of node N
function Dimensions_Msg_Of
- (N : Node_Id;
- Description_Needed : Boolean := False) return String;
+ (N : Node_Id;
+ Description_Needed : Boolean := False) return String;
-- Given a node N, return the dimension symbols of N, preceded by "has
-- dimension" if Description_Needed. If N is dimensionless, return "'[']",
-- or "is dimensionless" if Description_Needed.
-----------------------
function Dimensions_Msg_Of
- (N : Node_Id;
- Description_Needed : Boolean := False) return String
+ (N : Node_Id;
+ Description_Needed : Boolean := False) return String
is
Dims_Of_N : constant Dimension_Type := Dimensions_Of (N);
Dimensions_Msg : Name_Id;
-- to be the enclosing compilation unit of this scope.
procedure Set_Elaboration_Constraint
- (Call : Node_Id;
- Subp : Entity_Id;
- Scop : Entity_Id);
+ (Call : Node_Id;
+ Subp : Entity_Id;
+ Scop : Entity_Id);
-- The current unit U may depend semantically on some unit P that is not
-- in the current context. If there is an elaboration call that reaches P,
-- we need to indicate that P requires an Elaborate_All, but this is not
(Msg_D : String;
Msg_S : String;
Ent : Node_Or_Entity_Id);
- -- Generate a call to Error_Msg_NE with parameters Msg_D or Msg_S (for
- -- dynamic or static elaboration model), N and Ent. Msg_D is a real
- -- warning (output if Msg_D is non-null and Elab_Warnings is set),
- -- Msg_S is an info message (output if Elab_Info_Messages is set).
+ -- Generate a call to Error_Msg_NE with parameters Msg_D or Msg_S (for
+ -- dynamic or static elaboration model), N and Ent. Msg_D is a real
+ -- warning (output if Msg_D is non-null and Elab_Warnings is set),
+ -- Msg_S is an info message (output if Elab_Info_Messages is set).
function Find_W_Scope return Entity_Id;
-- Find top-level scope for called entity (not following renamings
--------------------------------
procedure Set_Elaboration_Constraint
- (Call : Node_Id;
- Subp : Entity_Id;
- Scop : Entity_Id)
+ (Call : Node_Id;
+ Subp : Entity_Id;
+ Scop : Entity_Id)
is
Elab_Unit : Entity_Id;
Match : Boolean;
function Same_Base_Type
- (Ptype : Node_Id;
- Formal : Entity_Id) return Boolean;
+ (Ptype : Node_Id;
+ Formal : Entity_Id) return Boolean;
-- Determines if Ptype references the type of Formal. Note that only
-- the base types need to match according to the spec. Ptype here is
-- the argument from the pragma, which is either a type name, or an
if Ekind (Spec_Id) = E_Function then
Error_Msg_N (Fix_Error
("pragma % cannot apply to function '[[]']"), N);
- return;
+ return;
elsif Ekind (Spec_Id) = E_Generic_Function then
Error_Msg_N (Fix_Error
if Ekind (Spec_Id) = E_Function then
Error_Msg_N (Fix_Error
("pragma % cannot apply to function '[[]']"), N);
- return;
+ return;
elsif Ekind (Spec_Id) = E_Generic_Function then
Error_Msg_N (Fix_Error
when Pragma_No_Return => Prag_No_Return : declare
function Check_No_Return
- (E : Entity_Id;
- N : Node_Id) return Boolean;
+ (E : Entity_Id;
+ N : Node_Id) return Boolean;
-- Check rule 6.5.1(4/3) of the Ada RM. If the rule is violated,
-- emit an error message and return False, otherwise return True.
-- 6.5.1 Nonreturning procedures:
---------------------
function Check_No_Return
- (E : Entity_Id;
- N : Node_Id) return Boolean
+ (E : Entity_Id;
+ N : Node_Id) return Boolean
is
begin
if Ekind (E) in E_Function | E_Generic_Function then
end if;
end if;
- Next_Elmt (State_Elmt);
+ Next_Elmt (State_Elmt);
end loop;
end if;
end Report_Unused_Body_States;
-------------------------------
function Enclosing_Lib_Unit_Entity
- (E : Entity_Id := Current_Scope) return Entity_Id
+ (E : Entity_Id := Current_Scope) return Entity_Id
is
Unit_Entity : Entity_Id;
procedure Inspect_Deferred_Constant_Completion (Decl : Node_Id) is
begin
- -- Deferred constant signature
-
- if Nkind (Decl) = N_Object_Declaration
- and then Constant_Present (Decl)
- and then No (Expression (Decl))
+ -- Deferred constant signature
- -- No need to check internally generated constants
+ if Nkind (Decl) = N_Object_Declaration
+ and then Constant_Present (Decl)
+ and then No (Expression (Decl))
- and then Comes_From_Source (Decl)
+ -- No need to check internally generated constants
- -- The constant is not completed. A full object declaration or a
- -- pragma Import complete a deferred constant.
+ and then Comes_From_Source (Decl)
- and then not Has_Completion (Defining_Identifier (Decl))
- then
- Error_Msg_N
- ("constant declaration requires initialization expression",
- Defining_Identifier (Decl));
- end if;
+ -- The constant is not completed. A full object declaration or a
+ -- pragma Import complete a deferred constant.
+ and then not Has_Completion (Defining_Identifier (Decl))
+ then
+ Error_Msg_N
+ ("constant declaration requires initialization expression",
+ Defining_Identifier (Decl));
+ end if;
end Inspect_Deferred_Constant_Completion;
procedure Inspect_Deferred_Constant_Completion (Decls : List_Id) is
----------------------------------
function Predicate_Failure_Expression
- (Typ : Entity_Id; Inherited_OK : Boolean) return Node_Id
+ (Typ : Entity_Id; Inherited_OK : Boolean) return Node_Id
is
PF_Aspect : constant Node_Id :=
Find_Aspect (Typ, Aspect_Predicate_Failure);
----------------------
function Trace_Components
- (T : Entity_Id;
- Check : Boolean) return Entity_Id
- is
+ (T : Entity_Id;
+ Check : Boolean) return Entity_Id
+ is
Btype : constant Entity_Id := Base_Type (T);
Component : Entity_Id;
P : Entity_Id;
-- Does the given value lie within the given interval?
procedure Normalize_Interval_List
- (List : in out Discrete_Interval_List; Last : out Nat);
+ (List : in out Discrete_Interval_List; Last : out Nat);
-- Perform sorting and merging as required by Check_Consistency
-------------------------
Sprint_Node (X);
Set_Sloc (X, Old_Sloc);
- -- Array subtypes
+ -- Array subtypes
- -- Preserve Sloc of index subtypes, as above
+ -- Preserve Sloc of index subtypes, as above
when E_Array_Subtype =>
Write_Header (False);
Ptr := Ptr + 1;
end if;
- -- To normalize, always put a '=' after
- -- -gnatep. Because that could lengthen the
- -- switch string, declare a local variable.
+ -- To normalize, always put a '=' after
+ -- -gnatep. Because that could lengthen the
+ -- switch string, declare a local variable.
declare
To_Store : String (1 .. Max - Ptr + 9);
Ptr := Ptr + 1;
end if;
- -- -gnat12
+ -- -gnat12
when '1' =>
Last_Stored := First_Stored;
Ptr := Ptr + 1;
end if;
- -- -gnat2005 -gnat2012
+ -- -gnat2005 -gnat2012
when '2' =>
if Ptr + 3 /= Max then
Verbose_Mode := True;
Verbosity_Level := Opt.High;
- -- Processing for x switch
+ -- Processing for x switch
when 'x' =>
External_Unit_Compilation_Allowed := True;
Use_Include_Path_File := True;
- -- Processing for z switch
+ -- Processing for z switch
when 'z' =>
No_Main_Subprogram := True;
- -- Any other small letter is an illegal switch
+ -- Any other small letter is an illegal switch
when others =>
if C in 'a' .. 'z' then
--------------
procedure Set_Item
- (Index : Table_Index_Type;
- Item : Table_Component_Type)
+ (Index : Table_Index_Type;
+ Item : Table_Component_Type)
is
-- If Item is a value within the current allocation, and we are going
-- to reallocate, then we must preserve an intermediate copy here
projects / thirdparty / gcc.git / commitdiff
