+2018-05-30 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * exp_aggr.adb, exp_ch3.adb, exp_ch4.adb, exp_ch7.adb, exp_unst.adb,
+ exp_util.adb, exp_util.ads, libgnat/a-calcon.adb, libgnat/a-calcon.ads,
+ libgnat/s-os_lib.adb, repinfo.adb, sem_ch3.adb, sem_disp.adb,
+ sem_disp.ads, sem_util.adb: Minor reformatting.
+
2018-05-30 Arnaud Charlet <charlet@adacore.com>
* gcc-interface/Makefile.in: Move special flags for Ada runtime files
return False;
end if;
- -- Duplicate expression for each index it covers.
+ -- Duplicate expression for each index it covers
Vals (Num) := New_Copy_Tree (Elmt);
Num := Num + 1;
if Needs_Conditional_Null_Excluding_Check (Full_Init_Type) then
- -- Look at the associated node for the object we are referencing and
- -- verify that we are expanding a call to an Init_Proc for an
+ -- Look at the associated node for the object we are referencing
+ -- and verify that we are expanding a call to an Init_Proc for an
-- internally generated object declaration before passing True and
-- skipping the relevant checks.
if Nkind (Id_Ref) in N_Has_Entity
and then Comes_From_Source (Associated_Node (Id_Ref))
then
- Append_To (Args,
- New_Occurrence_Of (Standard_True, Loc));
+ Append_To (Args, New_Occurrence_Of (Standard_True, Loc));
-- Otherwise, we pass False to perform null-excluding checks
else
- Append_To (Args,
- New_Occurrence_Of (Standard_False, Loc));
+ Append_To (Args, New_Occurrence_Of (Standard_False, Loc));
end if;
end if;
else
declare
Comp_Typ : Entity_Id;
+ Hi : Node_Id;
Indx : Node_Id;
Ityp : Entity_Id;
Lo : Node_Id;
- Hi : Node_Id;
begin
-- Do the comparison in the type (or its full view) and not in
Xtyp : constant Entity_Id := Etype (Operand);
Conv : Node_Id;
- Lo_Arg : Node_Id;
- Lo_Val : Node_Id;
Hi_Arg : Node_Id;
Hi_Val : Node_Id;
+ Lo_Arg : Node_Id;
+ Lo_Val : Node_Id;
Tnn : Entity_Id;
begin
if Is_Ordinary_Fixed_Point_Type (Target_Type)
and then Is_Floating_Point_Type (Operand_Type)
and then RM_Size (Base_Type (Target_Type)) <=
- RM_Size (Standard_Long_Integer)
+ RM_Size (Standard_Long_Integer)
and then Nkind (Lo) = N_Real_Literal
and then Nkind (Hi) = N_Real_Literal
then
if RM_Size (Bfx_Type) > RM_Size (Standard_Integer) then
Int_Type := Standard_Long_Integer;
- elsif
- RM_Size (Bfx_Type) > RM_Size (Standard_Short_Integer)
- then
+ elsif RM_Size (Bfx_Type) > RM_Size (Standard_Short_Integer) then
Int_Type := Standard_Integer;
else
-- Create integer objects for range checking of result.
- Lo_Arg := Unchecked_Convert_To (Int_Type,
- New_Occurrence_Of (Expr_Id, Loc));
- Lo_Val := Make_Integer_Literal (Loc,
- Corresponding_Integer_Value (Lo));
+ Lo_Arg :=
+ Unchecked_Convert_To
+ (Int_Type, New_Occurrence_Of (Expr_Id, Loc));
+
+ Lo_Val :=
+ Make_Integer_Literal (Loc, Corresponding_Integer_Value (Lo));
- Hi_Arg := Unchecked_Convert_To (Int_Type,
- New_Occurrence_Of (Expr_Id, Loc));
- Hi_Val := Make_Integer_Literal (Loc,
- Corresponding_Integer_Value (Hi));
+ Hi_Arg :=
+ Unchecked_Convert_To
+ (Int_Type, New_Occurrence_Of (Expr_Id, Loc));
+
+ Hi_Val :=
+ Make_Integer_Literal (Loc, Corresponding_Integer_Value (Hi));
-- Rewrite conversion as an integer conversion of the
-- original floating-point expression, followed by an
-- unchecked conversion to the target fixed-point type.
- Conv := Make_Unchecked_Type_Conversion (Loc,
- Subtype_Mark =>
- New_Occurrence_Of (Target_Type, Loc),
- Expression =>
- New_Occurrence_Of (Expr_Id, Loc));
+ Conv :=
+ Make_Unchecked_Type_Conversion (Loc,
+ Subtype_Mark => New_Occurrence_Of (Target_Type, Loc),
+ Expression => New_Occurrence_Of (Expr_Id, Loc));
end;
- else -- For all other conversions
+ -- All other conversions
+ else
Lo_Arg := New_Occurrence_Of (Tnn, Loc);
- Lo_Val := Make_Attribute_Reference (Loc,
- Attribute_Name => Name_First,
- Prefix =>
- New_Occurrence_Of (Target_Type, Loc));
+ Lo_Val :=
+ Make_Attribute_Reference (Loc,
+ Prefix => New_Occurrence_Of (Target_Type, Loc),
+ Attribute_Name => Name_First);
Hi_Arg := New_Occurrence_Of (Tnn, Loc);
- Hi_Val := Make_Attribute_Reference (Loc,
- Attribute_Name => Name_Last,
- Prefix =>
- New_Occurrence_Of (Target_Type, Loc));
+ Hi_Val :=
+ Make_Attribute_Reference (Loc,
+ Prefix => New_Occurrence_Of (Target_Type, Loc),
+ Attribute_Name => Name_Last);
end if;
-- Build code for range checking
Object_Definition => New_Occurrence_Of (Btyp, Loc),
Constant_Present => True,
Expression => Conv),
+
Make_Raise_Constraint_Error (Loc,
- Condition =>
- Make_Or_Else (Loc,
- Make_Op_Lt (Loc,
- Left_Opnd => Lo_Arg,
- Right_Opnd => Lo_Val),
+ Condition =>
+ Make_Or_Else (Loc,
+ Left_Opnd =>
+ Make_Op_Lt (Loc,
+ Left_Opnd => Lo_Arg,
+ Right_Opnd => Lo_Val),
Right_Opnd =>
Make_Op_Gt (Loc,
Left_Opnd => Hi_Arg,
Right_Opnd => Hi_Val)),
- Reason => CE_Range_Check_Failed)));
+ Reason => CE_Range_Check_Failed)));
Rewrite (N, New_Occurrence_Of (Tnn, Loc));
Analyze_And_Resolve (N, Btyp);
-- Has_Extra_Accessibility --
-----------------------------
- -- Returns true for a formal of an anonymous access type or for
- -- an Ada 2012-style stand-alone object of an anonymous access type.
+ -- Returns true for a formal of an anonymous access type or for an Ada
+ -- 2012-style stand-alone object of an anonymous access type.
function Has_Extra_Accessibility (Id : Entity_Id) return Boolean is
begin
Set_At_End_Proc (HSS, New_Occurrence_Of (Fin_Id, Loc));
-- Attach reference to finalizer to tree, for LLVM use
+
Set_Parent (At_End_Proc (HSS), HSS);
Analyze (At_End_Proc (HSS));
Callee : Entity_Id;
procedure Check_Static_Type
- (T : Entity_Id; N : Node_Id; DT : in out Boolean);
+ (T : Entity_Id;
+ N : Node_Id;
+ DT : in out Boolean);
-- Given a type T, checks if it is a static type defined as a type
-- with no dynamic bounds in sight. If so, the only action is to
-- set Is_Static_Type True for T. If T is not a static type, then
-----------------------
procedure Check_Static_Type
- (T : Entity_Id; N : Node_Id; DT : in out Boolean)
+ (T : Entity_Id;
+ N : Node_Id;
+ DT : in out Boolean)
is
procedure Note_Uplevel_Bound (N : Node_Id; Ref : Node_Id);
-- N is the bound of a dynamic type. This procedure notes that
begin
-- Entity name case. Make sure that the entity is declared
-- in a subprogram. This may not be the case for for a type
- -- in a loop appearing in a precondition.
- -- Exclude explicitly discriminants (that can appear
- -- in bounds of discriminated components).
+ -- in a loop appearing in a precondition. Exclude explicitly
+ -- discriminants (that can appear in bounds of discriminated
+ -- components).
if Is_Entity_Name (N) then
if Present (Entity (N))
end if;
end if;
- -- for all calls where the formal is an unconstrained array
- -- and the actual is constrained we need to check the bounds.
+ -- for all calls where the formal is an unconstrained array and
+ -- the actual is constrained we need to check the bounds.
declare
- Subp : Entity_Id;
Actual : Entity_Id;
- Formal : Node_Id;
DT : Boolean := False;
+ Formal : Node_Id;
+ Subp : Entity_Id;
begin
if Nkind (Name (N)) = N_Explicit_Dereference then
elsif Nkind (N) = N_Handled_Sequence_Of_Statements
and then Present (At_End_Proc (N))
then
+ -- An At_End_Proc means there's a call from this block to that
+ -- subprogram.
- -- An At_End_Proc means there's a call from this block
- -- to that subprogram.
-
- Append_Unique_Call ((N, Current_Subprogram,
- Entity (At_End_Proc (N))));
+ Append_Unique_Call
+ ((N, Current_Subprogram, Entity (At_End_Proc (N))));
-- Handle a 'Access as a (potential) call
declare
Attr : constant Attribute_Id :=
Get_Attribute_Id (Attribute_Name (N));
+
begin
case Attr is
when Attribute_Access
end if;
end if;
- -- References to bounds can be uplevel references if
- -- the type isn't static.
+ -- References to bounds can be uplevel references if the
+ -- type isn't static.
when Attribute_First
| Attribute_Last
declare
DT : Boolean := False;
begin
- Check_Static_Type (Etype (Prefix (N)),
- Empty, DT);
+ Check_Static_Type
+ (Etype (Prefix (N)), Empty, DT);
end;
return OK;
end;
-- 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.
+ -- 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. The prefixes of these nodes denote parent
- -- units and carry no type information so they are skipped.
+ -- child units. The prefixes of these nodes denote parent units
+ -- and carry no type information so they are skipped.
elsif Nkind (N) = N_Selected_Component
and then Present (Etype (Prefix (N)))
Check_Static_Type (Etype (Prefix (N)), Empty, DT);
end;
- -- Record a subprogram. We record a subprogram body that acts as
- -- a spec. Otherwise we record a subprogram declaration, providing
+ -- Record a subprogram. We record a subprogram body that acts as a
+ -- spec. Otherwise we record a subprogram declaration, providing
-- that it has a corresponding body we can get hold of. The case
-- of no corresponding body being available is ignored for now.
(Typ : Entity_Id) return Boolean
is
begin
- return Is_Array_Type (Typ)
- and then Can_Never_Be_Null (Component_Type (Typ));
+ return
+ Is_Array_Type (Typ) and then Can_Never_Be_Null (Component_Type (Typ));
end Needs_Conditional_Null_Excluding_Check;
----------------------------
return False;
else
-
-- Otherwise, we require the address clause to be constant because
-- the call to the initialization procedure (or the attach code) has
-- to happen at the point of the declaration.
-- to repeat the checks.
function Enclosing_Init_Proc return Entity_Id;
- -- Obtain the entity associated with the enclosing type Init_Proc by
- -- examining the current scope. If not inside an Init_Proc at the point of
- -- call Empty will be returned.
+ -- Obtain the entity of the type initialization procedure which encloses
+ -- the current scope. Return Empty if no such procedure exists.
procedure Ensure_Defined (Typ : Entity_Id; N : Node_Id);
-- This procedure ensures that type referenced by Typ is defined. For the
-- --
------------------------------------------------------------------------------
-with Interfaces.C; use Interfaces.C;
+with Interfaces.C; use Interfaces.C;
with Interfaces.C.Extensions; use Interfaces.C.Extensions;
package body Ada.Calendar.Conversions is
function To_Unix_Time (Ada_Time : Time) return long is
Val : constant Long_Integer :=
- Conversion_Operations.To_Unix_Time (Ada_Time);
+ Conversion_Operations.To_Unix_Time (Ada_Time);
begin
return long (Val);
end To_Unix_Time;
function To_Unix_Nano_Time (Ada_Time : Time) return long_long is
pragma Unsuppress (Overflow_Check);
Ada_Rep : constant Time_Rep := Time_Rep (Ada_Time);
+
begin
return long_long (Ada_Rep + Epoch_Offset);
+
exception
when Constraint_Error =>
raise Time_Error;
-- units of the result are seconds. Raises Time_Error if the result cannot
-- fit into a Time value.
- function To_Unix_Nano_Time (Ada_Time : Time) return
- Interfaces.C.Extensions.long_long;
+ function To_Unix_Nano_Time
+ (Ada_Time : Time) return Interfaces.C.Extensions.long_long;
-- Convert a time value represented as number of time units since the Ada
-- implementation-defined Epoch to a value relative to the Unix Epoch. The
-- units of the result are nanoseconds. Raises Time_Error if the result
-- and additional fragments up to Max_Path in length in case
-- there are any symlinks.
- Start, Finish : Positive;
- Status : Integer;
+ Finish : Positive;
+ Start : Positive;
+ Status : Integer;
-- Start of processing for Normalize_Pathname
Write_Str (" .. ");
end if;
- -- Allowing Uint_0 here is an annoying special case. Really
- -- this should be a fine Esize value but currently it means
- -- unknown, except that we know after gigi has back annotated
- -- that a size of zero is real, since otherwise gigi back
- -- annotates using No_Uint as the value to indicate unknown.
+ -- Allowing Uint_0 here is an annoying special case. Really this
+ -- should be a fine Esize value but currently it means unknown,
+ -- except that we know after gigi has back annotated that a size
+ -- of zero is real, since otherwise gigi back annotates using
+ -- No_Uint as the value to indicate unknown.
if (Esize (Ent) = Uint_0 or else Known_Static_Esize (Ent))
and then Known_Static_Normalized_First_Bit (Ent)
UI_Write (Lbit);
end if;
- -- The test for Esize (Ent) not Uint_0 here is an annoying
- -- special case. Officially a value of zero for Esize means
- -- unknown, but here we use the fact that we know that gigi
- -- annotates Esize with No_Uint, not Uint_0. Really everyone
- -- should use No_Uint???
+ -- The test for Esize (Ent) not Uint_0 here is an annoying special
+ -- case. Officially a value of zero for Esize means unknown, but
+ -- here we use the fact that we know that gigi annotates Esize with
+ -- No_Uint, not Uint_0. Really everyone should use No_Uint???
elsif List_Representation_Info < 3
or else (Esize (Ent) /= Uint_0 and then Unknown_Esize (Ent))
else
Write_Val (Esiz, Paren => not List_Representation_Info_To_JSON);
- -- If in front-end layout mode, then dynamic size is stored
- -- in storage units, so renormalize for output.
+ -- If in front-end layout mode, then dynamic size is stored in
+ -- storage units, so renormalize for output.
if not Back_End_Layout then
Write_Str (" * ");
Variant : Node_Id := Empty;
Indent : Natural := 0)
is
-
function Derived_Discriminant (Disc : Entity_Id) return Entity_Id;
-- This function assumes that Outer_Ent is an extension of Ent.
-- Disc is a discriminant of Ent that does not itself constrain a
----------------------------
function Derived_Discriminant (Disc : Entity_Id) return Entity_Id is
- Corr_Disc, Derived_Disc : Entity_Id;
+ Corr_Disc : Entity_Id;
+ Derived_Disc : Entity_Id;
begin
Derived_Disc := First_Stored_Discriminant (Outer_Ent);
Corr_Disc := Corresponding_Discriminant (Corr_Disc);
end loop;
- if Original_Record_Component (Corr_Disc)
- = Original_Record_Component (Disc)
+ if Original_Record_Component (Corr_Disc) =
+ Original_Record_Component (Disc)
then
return Derived_Disc;
end if;
Comp : Node_Id;
Comp_List : Node_Id;
- Var : Node_Id;
First : Boolean := True;
+ Var : Node_Id;
-- Start of processing for List_Structural_Record_Layout
else
declare
Definition : Node_Id :=
- Type_Definition (Declaration_Node (Ent));
+ Type_Definition (Declaration_Node (Ent));
+
Is_Extension : constant Boolean :=
- Is_Tagged_Type (Ent)
- and then
- Nkind (Definition) = N_Derived_Type_Definition;
- Disc, Listed_Disc : Entity_Id;
+ Is_Tagged_Type (Ent)
+ and then Nkind (Definition) =
+ N_Derived_Type_Definition;
+
+ Disc : Entity_Id;
+ Listed_Disc : Entity_Id;
begin
-- If this is an extension, first list the layout of the parent
Set_Ekind (T_Name, E_Access_Subprogram_Type);
end if;
- Set_Can_Use_Internal_Rep (T_Name, not Always_Compatible_Rep_On_Target);
-
+ Set_Can_Use_Internal_Rep (T_Name,
+ not Always_Compatible_Rep_On_Target);
Set_Etype (T_Name, T_Name);
Init_Size_Align (T_Name);
Set_Directly_Designated_Type (T_Name, Desig_Type);
-- But it is a real entity, and a birth certificate must be properly
-- registered by entering it into the entity list, and setting its
- -- scope to the given subtype. This turns out to be useful for the
+ -- scope to the given subtype. This turns out to be useful for the
-- LLVM code generator, but that scope is not used otherwise.
Enter_Name (New_Compon);
-- table, but it would be awfully heavy, and there is no way that we
-- could reasonably exceed this value.
- N : Nat := 0;
+ N : Nat := 0;
-- Number of entries in Result
Parent_Op : Entity_Id;
Result (N) := E;
end Store_IS;
- -- Start of processing for Inherited_Subprograms
+ -- Start of processing for Inherited_Subprograms
begin
pragma Assert (not (No_Interfaces and Interfaces_Only));
and then Is_Dispatching_Operation (S)
and then Present (Find_DT (S))
then
-
-- Deal with direct inheritance
if not Interfaces_Only then
loop
Parent_Op := Overridden_Operation (Parent_Op);
exit when No (Parent_Op)
- or else
- (No_Interfaces
- and then
- Is_Interface (Find_DT (Parent_Op)));
+ or else (No_Interfaces
+ and then Is_Interface (Find_DT (Parent_Op)));
if Is_Subprogram_Or_Generic_Subprogram (Parent_Op) then
Store_IS (Parent_Op);
package Inheritance_Utilities is
-- This package provides generic versions of inheritance utilities
- -- provided here. These versions are used in GNATprove backend to
- -- adapt these utilities to GNATprove specific version of visibility of
- -- types.
+ -- provided here. These versions are used in GNATprove backend to adapt
+ -- these utilities to GNATprove specific version of visibility of types.
function Inherited_Subprograms
(S : Entity_Id;
-- Locate the primitive subprograms of the type
else
- -- The primitive operations appear after the base type, except
- -- if the derivation happens within the private part of B_Scope
- -- and the type is a private type, in which case both the type
- -- and some primitive operations may appear before the base
- -- type, and the list of candidates starts after the type.
+ -- The primitive operations appear after the base type, except if the
+ -- derivation happens within the private part of B_Scope and the type
+ -- is a private type, in which case both the type and some primitive
+ -- operations may appear before the base type, and the list of
+ -- candidates starts after the type.
if In_Open_Scopes (B_Scope)
and then Scope (T) = B_Scope
then
Id := Next_Entity (T);
- -- In Ada 2012, If the type has an incomplete partial view, there
- -- may be primitive operations declared before the full view, so
- -- we need to start scanning from the incomplete view, which is
- -- earlier on the entity chain.
+ -- In Ada 2012, If the type has an incomplete partial view, there may
+ -- be primitive operations declared before the full view, so we need
+ -- to start scanning from the incomplete view, which is earlier on
+ -- the entity chain.
elsif Nkind (Parent (B_Type)) = N_Full_Type_Declaration
and then Present (Incomplete_View (Parent (B_Type)))
projects / gcc.git / commitdiff