Commit eedc5882 by Hristian Kirtchev Committed by Pierre-Marie de Rodat

[Ada] Minor reformatting

2019-07-04  Hristian Kirtchev  <kirtchev@adacore.com>

gcc/ada/

	* exp_ch3.adb, exp_ch4.adb, exp_ch4.ads, exp_ch5.adb,
	exp_ch7.adb, exp_ch9.adb, exp_ch11.adb, exp_unst.adb,
	rtsfind.ads, sem_attr.adb, sem_ch10.adb, sem_ch12.adb,
	sem_ch13.adb, sem_dim.adb, sem_disp.adb, xref_lib.adb: Minor
	reformatting.

From-SVN: r273070
parent 38818659
2019-07-04 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch3.adb, exp_ch4.adb, exp_ch4.ads, exp_ch5.adb,
exp_ch7.adb, exp_ch9.adb, exp_ch11.adb, exp_unst.adb,
rtsfind.ads, sem_attr.adb, sem_ch10.adb, sem_ch12.adb,
sem_ch13.adb, sem_dim.adb, sem_disp.adb, xref_lib.adb: Minor
reformatting.
2019-07-04 Joffrey Huguet <huguet@adacore.com>
* libgnarl/a-taside.ads: Add assertion policy to ignore
......
......@@ -1308,8 +1308,8 @@ package body Exp_Ch11 is
Append_To (L,
Make_Character_Literal (Loc,
Chars => Name_uA,
Char_Literal_Value => UI_From_Int (Character'Pos ('A'))));
Chars => Name_uA,
Char_Literal_Value => UI_From_Int (Character'Pos ('A'))));
-- Name_Length component: Nam'Length
......
......@@ -4848,7 +4848,7 @@ package body Exp_Ch3 is
Make_Range (Sloc (Enumeration_Rep_Expr (Ent)),
Low_Bound =>
Make_Integer_Literal (Loc,
Intval => Enumeration_Rep (Ent)),
Intval => Enumeration_Rep (Ent)),
High_Bound =>
Make_Integer_Literal (Loc, Intval => Last_Repval))),
......@@ -9486,10 +9486,11 @@ package body Exp_Ch3 is
(E : Entity_Id;
L : List_Id) return Node_Id
is
Loc : constant Source_Ptr := Sloc (E);
Loc : constant Source_Ptr := Sloc (E);
C : Node_Id;
Field_Name : Name_Id;
Cond : Node_Id;
Field_Name : Name_Id;
Next_Test : Node_Id;
Typ : Entity_Id;
......@@ -9534,11 +9535,11 @@ package body Exp_Ch3 is
begin
-- Build equality code with a user-defined operator, if
-- available, and with the predefined "=" otherwise.
-- For compatibility with older Ada versions, and preserve
-- the workings of some ASIS tools, we also use the
-- predefined operation if the component-type equality
-- is abstract, rather than raising Program_Error.
-- available, and with the predefined "=" otherwise. For
-- compatibility with older Ada versions, and preserve the
-- workings of some ASIS tools, we also use the predefined
-- operation if the component-type equality is abstract,
-- rather than raising Program_Error.
if Ada_Version < Ada_2012 then
Next_Test := Make_Op_Ne (Loc, Lhs, Rhs);
......
......@@ -415,6 +415,52 @@ package body Exp_Ch4 is
return;
end Build_Boolean_Array_Proc_Call;
-----------------------
-- Build_Eq_Call --
-----------------------
function Build_Eq_Call
(Typ : Entity_Id;
Loc : Source_Ptr;
Lhs : Node_Id;
Rhs : Node_Id) return Node_Id
is
Prim : Node_Id;
Prim_E : Elmt_Id;
begin
Prim_E := First_Elmt (Collect_Primitive_Operations (Typ));
while Present (Prim_E) loop
Prim := Node (Prim_E);
-- Locate primitive equality with the right signature
if Chars (Prim) = Name_Op_Eq
and then Etype (First_Formal (Prim)) =
Etype (Next_Formal (First_Formal (Prim)))
and then Etype (Prim) = Standard_Boolean
then
if Is_Abstract_Subprogram (Prim) then
return
Make_Raise_Program_Error (Loc,
Reason => PE_Explicit_Raise);
else
return
Make_Function_Call (Loc,
Name => New_Occurrence_Of (Prim, Loc),
Parameter_Associations => New_List (Lhs, Rhs));
end if;
end if;
Next_Elmt (Prim_E);
end loop;
-- If not found, predefined operation will be used
return Empty;
end Build_Eq_Call;
--------------------------------
-- Displace_Allocator_Pointer --
--------------------------------
......@@ -1938,7 +1984,7 @@ package body Exp_Ch4 is
Parameter_Specifications => Formals,
Result_Definition => New_Occurrence_Of (Standard_Boolean, Loc)),
Declarations => Decls,
Declarations => Decls,
Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc,
......@@ -12553,52 +12599,6 @@ package body Exp_Ch4 is
Adjust_Result_Type (N, Typ);
end Expand_Short_Circuit_Operator;
-----------------------
-- Build_Eq_Call --
-----------------------
function Build_Eq_Call
(Typ : Entity_Id;
Loc : Source_Ptr;
Lhs : Node_Id;
Rhs : Node_Id) return Node_Id
is
Prim_E : Elmt_Id;
Prim : Node_Id;
begin
Prim_E := First_Elmt (Collect_Primitive_Operations (Typ));
while Present (Prim_E) loop
Prim := Node (Prim_E);
-- Locate primitive equality with the right signature
if Chars (Prim) = Name_Op_Eq
and then Etype (First_Formal (Prim)) =
Etype (Next_Formal (First_Formal (Prim)))
and then Etype (Prim) = Standard_Boolean
then
if Is_Abstract_Subprogram (Prim) then
return
Make_Raise_Program_Error (Loc,
Reason => PE_Explicit_Raise);
else
return
Make_Function_Call (Loc,
Name => New_Occurrence_Of (Prim, Loc),
Parameter_Associations => New_List (Lhs, Rhs));
end if;
end if;
Next_Elmt (Prim_E);
end loop;
-- If not found, predefined operation will be used
return Empty;
end Build_Eq_Call;
------------------------------------
-- Fixup_Universal_Fixed_Operation --
-------------------------------------
......
......@@ -29,20 +29,6 @@ with Types; use Types;
package Exp_Ch4 is
function Build_Eq_Call
(Typ : Entity_Id;
Loc : Source_Ptr;
Lhs : Node_Id;
Rhs : Node_Id) return Node_Id;
-- AI05-0123: Locate primitive equality for type if it exists, and build
-- the corresponding call. If operation is abstract, replace call with
-- an explicit raise. Return Empty if there is no primitive.
-- Used in the construction of record-equality routines for records here
-- and for variant records in exp_ch3.adb. These two paths are distinct
-- for historical but also technical reasons: for variant records the
-- constructed function includes a case statement with nested returns,
-- while for records without variants only a simple expression is needed.
procedure Expand_N_Allocator (N : Node_Id);
procedure Expand_N_And_Then (N : Node_Id);
procedure Expand_N_Case_Expression (N : Node_Id);
......@@ -88,13 +74,26 @@ package Exp_Ch4 is
procedure Expand_N_Unchecked_Expression (N : Node_Id);
procedure Expand_N_Unchecked_Type_Conversion (N : Node_Id);
function Build_Eq_Call
(Typ : Entity_Id;
Loc : Source_Ptr;
Lhs : Node_Id;
Rhs : Node_Id) return Node_Id;
-- AI05-0123: Locate primitive equality for type if it exists, and build
-- the corresponding call. If operation is abstract, replace call with
-- an explicit raise. Return Empty if there is no primitive.
-- Used in the construction of record-equality routines for records here
-- and for variant records in exp_ch3.adb. These two paths are distinct
-- for historical but also technical reasons: for variant records the
-- constructed function includes a case statement with nested returns,
-- while for records without variants only a simple expression is needed.
function Expand_Record_Equality
(Nod : Node_Id;
Typ : Entity_Id;
Lhs : Node_Id;
Rhs : Node_Id;
Bodies : List_Id)
return Node_Id;
Bodies : List_Id) return Node_Id;
-- Expand a record equality into an expression that compares the fields
-- individually to yield the required Boolean result. Loc is the
-- location for the generated nodes. Typ is the type of the record, and
......
......@@ -3304,7 +3304,7 @@ package body Exp_Ch5 is
Declarations => New_List (Elmt_Decl),
Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc,
Statements => Stats))));
Statements => Stats))));
else
Elmt_Ref :=
......@@ -3330,7 +3330,7 @@ package body Exp_Ch5 is
Declarations => New_List (Elmt_Decl),
Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc,
Statements => New_List (New_Loop)));
Statements => New_List (New_Loop)));
end if;
-- The element is only modified in expanded code, so it appears as
......
......@@ -3873,7 +3873,7 @@ package body Exp_Ch7 is
Attribute_Name => Name_Range,
Expressions => New_List (
Make_Integer_Literal (Loc, Dim))))),
Statements => Free_One_Dimension (Dim + 1)));
Statements => Free_One_Dimension (Dim + 1)));
end if;
end Free_One_Dimension;
......
......@@ -869,7 +869,7 @@ package body Exp_Ch9 is
Make_Implicit_Exception_Handler (Loc,
Exception_Choices => New_List (Ohandle),
Statements => New_List (
Statements => New_List (
Make_Procedure_Call_Statement (Sloc (Stats),
Name => New_Occurrence_Of (
RTE (RE_Exceptional_Complete_Rendezvous), Sloc (Stats)),
......@@ -3792,7 +3792,7 @@ package body Exp_Ch9 is
Make_Implicit_Exception_Handler (EH_Loc,
Exception_Choices => New_List (Ohandle),
Statements => New_List (
Statements => New_List (
Make_Procedure_Call_Statement (EH_Loc,
Name => Complete,
Parameter_Associations => New_List (
......@@ -10639,7 +10639,7 @@ package body Exp_Ch9 is
Statements => New_List (
Make_Implicit_If_Statement (N,
Condition => Cond,
Condition => Cond,
Then_Statements => New_List (
Make_Select_Call (
New_Occurrence_Of (RTE (RE_Simple_Mode), Loc)),
......
......@@ -598,7 +598,7 @@ package body Exp_Unst is
then
Note_Uplevel_Bound (Prefix (N), Ref);
-- Conditional expressions.
-- Conditional expressions
elsif Nkind (N) = N_If_Expression then
declare
......
......@@ -2755,23 +2755,23 @@ package Rtsfind is
RE_W_WC => System_Stream_Attributes,
RE_W_WWC => System_Stream_Attributes,
RE_Storage_Array_Input => System_Strings_Stream_Ops,
RE_Storage_Array_Input_Blk_IO => System_Strings_Stream_Ops,
RE_Storage_Array_Output => System_Strings_Stream_Ops,
RE_Storage_Array_Output_Blk_IO => System_Strings_Stream_Ops,
RE_Storage_Array_Read => System_Strings_Stream_Ops,
RE_Storage_Array_Read_Blk_IO => System_Strings_Stream_Ops,
RE_Storage_Array_Write => System_Strings_Stream_Ops,
RE_Storage_Array_Write_Blk_IO => System_Strings_Stream_Ops,
RE_Stream_Element_Array_Input => System_Strings_Stream_Ops,
RE_Stream_Element_Array_Input_Blk_IO => System_Strings_Stream_Ops,
RE_Stream_Element_Array_Output => System_Strings_Stream_Ops,
RE_Stream_Element_Array_Output_Blk_IO => System_Strings_Stream_Ops,
RE_Stream_Element_Array_Read => System_Strings_Stream_Ops,
RE_Stream_Element_Array_Read_Blk_IO => System_Strings_Stream_Ops,
RE_Stream_Element_Array_Write => System_Strings_Stream_Ops,
RE_Stream_Element_Array_Write_Blk_IO => System_Strings_Stream_Ops,
RE_Storage_Array_Input => System_Strings_Stream_Ops,
RE_Storage_Array_Input_Blk_IO => System_Strings_Stream_Ops,
RE_Storage_Array_Output => System_Strings_Stream_Ops,
RE_Storage_Array_Output_Blk_IO => System_Strings_Stream_Ops,
RE_Storage_Array_Read => System_Strings_Stream_Ops,
RE_Storage_Array_Read_Blk_IO => System_Strings_Stream_Ops,
RE_Storage_Array_Write => System_Strings_Stream_Ops,
RE_Storage_Array_Write_Blk_IO => System_Strings_Stream_Ops,
RE_Stream_Element_Array_Input => System_Strings_Stream_Ops,
RE_Stream_Element_Array_Input_Blk_IO => System_Strings_Stream_Ops,
RE_Stream_Element_Array_Output => System_Strings_Stream_Ops,
RE_Stream_Element_Array_Output_Blk_IO => System_Strings_Stream_Ops,
RE_Stream_Element_Array_Read => System_Strings_Stream_Ops,
RE_Stream_Element_Array_Read_Blk_IO => System_Strings_Stream_Ops,
RE_Stream_Element_Array_Write => System_Strings_Stream_Ops,
RE_Stream_Element_Array_Write_Blk_IO => System_Strings_Stream_Ops,
RE_String_Input => System_Strings_Stream_Ops,
RE_String_Input_Blk_IO => System_Strings_Stream_Ops,
......
......@@ -11421,7 +11421,7 @@ package body Sem_Attr is
if Present (Lo) then
Rewrite (P,
Make_Indexed_Component (Loc,
Prefix => Relocate_Node (Prefix (P)),
Prefix => Relocate_Node (Prefix (P)),
Expressions => New_List (Lo)));
Analyze_And_Resolve (P);
......
......@@ -6395,8 +6395,8 @@ package body Sem_Ch10 is
if Limited_View_Installed (Item) then
Remove_Limited_With_Clause (Item);
-- An unusual case: If the library unit of the Main_Unit has
-- a limited with_clause on some unit P and the context somewhere
-- An unusual case: If the library unit of the Main_Unit has a
-- limited with_clause on some unit P and the context somewhere
-- includes a with_clause on P, P has been analyzed. The entity
-- for P is still visible, which in general is harmless because
-- this is the end of the compilation, but it can affect pending
......@@ -6409,7 +6409,7 @@ package body Sem_Ch10 is
and then not Implicit_With (Item)
then
Set_Is_Immediately_Visible
(Defining_Entity (Unit (Library_Unit (Item))), False);
(Defining_Entity (Unit (Library_Unit (Item))), False);
end if;
end if;
......
......@@ -6002,7 +6002,7 @@ package body Sem_Ch12 is
Make_Parameter_Specification (Loc,
Defining_Identifier => F1,
Parameter_Type => New_Occurrence_Of (Op_Type, Loc))),
Result_Definition => New_Occurrence_Of (Ret_Type, Loc));
Result_Definition => New_Occurrence_Of (Ret_Type, Loc));
if Is_Binary then
Append_To (Parameter_Specifications (Spec),
......@@ -14103,7 +14103,6 @@ package body Sem_Ch12 is
------------------------
procedure Preanalyze_Actuals (N : Node_Id; Inst : Entity_Id := Empty) is
procedure Perform_Appropriate_Analysis (N : Node_Id);
-- Determine if the actuals we are analyzing come from a generic
-- instantiation that is a library unit and dispatch accordingly.
......@@ -14120,15 +14119,17 @@ package body Sem_Ch12 is
if Present (Inst) and then Is_Compilation_Unit (Inst) then
Preanalyze (N);
else
Analyze (N);
end if;
end Perform_Appropriate_Analysis;
-- Local variables
Errs : constant Nat := Serious_Errors_Detected;
Assoc : Node_Id;
Act : Node_Id;
Errs : constant Nat := Serious_Errors_Detected;
Cur : Entity_Id := Empty;
-- Current homograph of the instance name
......
......@@ -5511,7 +5511,7 @@ package body Sem_Ch13 is
-- Default_Iterator --
----------------------
when Attribute_Default_Iterator => Default_Iterator : declare
when Attribute_Default_Iterator => Default_Iterator : declare
Func : Entity_Id;
Typ : Entity_Id;
......
......@@ -399,9 +399,9 @@ package body Sem_Dim is
function "+" (Left, Right : Rational) return Rational is
R : constant Rational :=
Rational'(Numerator => Left.Numerator * Right.Denominator +
Left.Denominator * Right.Numerator,
Denominator => Left.Denominator * Right.Denominator);
Rational'(Numerator => Left.Numerator * Right.Denominator +
Left.Denominator * Right.Numerator,
Denominator => Left.Denominator * Right.Denominator);
begin
return Reduce (R);
end "+";
......
......@@ -210,6 +210,7 @@ package body Sem_Disp is
Ctrl_Type := Check_Controlling_Type (Etype (Formal), Subp);
if Present (Ctrl_Type) then
-- Obtain the full type in case we are looking at an incomplete
-- view.
......
......@@ -1876,7 +1876,7 @@ package body Xref_Lib is
end if;
exception
when No_Xref_Information => null;
when No_Xref_Information => null;
end;
end loop;
end Search_Xref;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment