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

[Ada] Minor reformatting

Browse Source 
2018-05-30  Hristian Kirtchev  <kirtchev@adacore.com>

gcc/ada/

	* 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.

From-SVN: r260923
This commit is contained in:
Hristian Kirtchev 2018-05-30 08:56:18 +00:00 committed by Pierre-Marie de Rodat
parent c0368be1a1
commit f537fc00c7
16 changed files with 137 additions and 125 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
gcc/ada/ChangeLog
View File

@ -1,3 +1,10 @@
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

2
gcc/ada/exp_aggr.adb
View File

@ -4490,7 +4490,7 @@ package body Exp_Aggr is
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;

10
gcc/ada/exp_ch3.adb
View File

@ -1554,22 +1554,20 @@ package body Exp_Ch3 is
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;

78
gcc/ada/exp_ch4.adb
View File

@ -2435,10 +2435,10 @@ package body Exp_Ch4 is
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
@ -10976,10 +10976,10 @@ package body Exp_Ch4 is
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
@ -11103,7 +11103,7 @@ package body Exp_Ch4 is
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
@ -11120,9 +11120,7 @@ package body Exp_Ch4 is
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
@ -11145,40 +11143,44 @@ package body Exp_Ch4 is
-- 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));
Hi_Arg := Unchecked_Convert_To (Int_Type,
New_Occurrence_Of (Expr_Id, Loc));
Hi_Val := Make_Integer_Literal (Loc,
Corresponding_Integer_Value (Hi));
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));
-- 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
@ -11189,18 +11191,20 @@ package body Exp_Ch4 is
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);
@ -11210,8 +11214,8 @@ package body Exp_Ch4 is
-- 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

1
gcc/ada/exp_ch7.adb
View File

@ -3521,6 +3521,7 @@ package body Exp_Ch7 is
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));

53
gcc/ada/exp_unst.adb
View File

@ -367,7 +367,9 @@ package body Exp_Unst is
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
@ -391,7 +393,9 @@ package body Exp_Unst is
-----------------------
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
@ -410,9 +414,9 @@ package body Exp_Unst is
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))
@ -645,14 +649,14 @@ package body Exp_Unst is
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
@ -679,12 +683,11 @@ package body Exp_Unst is
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
@ -692,6 +695,7 @@ package body Exp_Unst is
declare
Attr : constant Attribute_Id :=
Get_Attribute_Id (Attribute_Name (N));
begin
case Attr is
when Attribute_Access
@ -715,8 +719,8 @@ package body Exp_Unst is
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
@ -733,8 +737,8 @@ package body Exp_Unst is
declare
DT : Boolean := False;
begin
Check_Static_Type (Etype (Prefix (N)),
Empty, DT);
Check_Static_Type
(Etype (Prefix (N)), Empty, DT);
end;
return OK;
@ -759,13 +763,12 @@ package body Exp_Unst is
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)))
@ -776,8 +779,8 @@ package body Exp_Unst is
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.

5
gcc/ada/exp_util.adb
View File

@ -10449,8 +10449,8 @@ package body Exp_Util is
(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;
----------------------------
@ -10495,7 +10495,6 @@ package body Exp_Util is
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.

5
gcc/ada/exp_util.ads
View File

@ -506,9 +506,8 @@ package Exp_Util is
-- 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

6
gcc/ada/libgnat/a-calcon.adb
View File

@ -29,7 +29,7 @@
-- --
------------------------------------------------------------------------------
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
@ -141,7 +141,7 @@ 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;
@ -153,8 +153,10 @@ package body Ada.Calendar.Conversions is
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;

4
gcc/ada/libgnat/a-calcon.ads
View File

@ -111,8 +111,8 @@ package Ada.Calendar.Conversions is
-- 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

5
gcc/ada/libgnat/s-os_lib.adb
View File

@ -2235,8 +2235,9 @@ package body System.OS_Lib is
-- 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

46
gcc/ada/repinfo.adb
View File

@ -1279,11 +1279,11 @@ package body Repinfo is
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)
@ -1300,11 +1300,10 @@ package body Repinfo is
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))
@ -1316,8 +1315,8 @@ package body Repinfo is
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 (" * ");
@ -1433,7 +1432,6 @@ package body Repinfo is
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
@ -1445,7 +1443,8 @@ package body Repinfo is
----------------------------
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);
@ -1465,8 +1464,8 @@ package body Repinfo is
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;
@ -1484,8 +1483,8 @@ package body Repinfo is
Comp : Node_Id;
Comp_List : Node_Id;
Var : Node_Id;
First : Boolean := True;
Var : Node_Id;
-- Start of processing for List_Structural_Record_Layout
@ -1501,12 +1500,15 @@ package body Repinfo is
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

6
gcc/ada/sem_ch3.adb
View File

@ -1299,8 +1299,8 @@ package body Sem_Ch3 is
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);
@ -14631,7 +14631,7 @@ package body Sem_Ch3 is
-- 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);

11
gcc/ada/sem_disp.adb
View File

@ -2221,7 +2221,7 @@ package body Sem_Disp is
-- 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;
@ -2246,7 +2246,7 @@ package body Sem_Disp is
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));
@ -2258,7 +2258,6 @@ package body Sem_Disp is
and then Is_Dispatching_Operation (S)
and then Present (Find_DT (S))
then
-- Deal with direct inheritance
if not Interfaces_Only then
@ -2266,10 +2265,8 @@ package body Sem_Disp is
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);

5
gcc/ada/sem_disp.ads
View File

@ -105,9 +105,8 @@ package Sem_Disp is
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;

18
gcc/ada/sem_util.adb
View File

@ -5164,11 +5164,11 @@ package body Sem_Util is
-- 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
@ -5176,10 +5176,10 @@ package body Sem_Util is
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)))