+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
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
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))),
(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;
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);
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 --
--------------------------------
Parameter_Specifications => Formals,
Result_Definition => New_Occurrence_Of (Standard_Boolean, Loc)),
- Declarations => Decls,
+ Declarations => Decls,
Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc,
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 --
-------------------------------------
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);
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
Declarations => New_List (Elmt_Decl),
Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc,
- Statements => Stats))));
+ Statements => Stats))));
else
Elmt_Ref :=
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
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;
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)),
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 (
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)),
then
Note_Uplevel_Bound (Prefix (N), Ref);
- -- Conditional expressions.
+ -- Conditional expressions
elsif Nkind (N) = N_If_Expression then
declare
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,
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);
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
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;
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),
------------------------
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.
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
-- Default_Iterator --
----------------------
- when Attribute_Default_Iterator => Default_Iterator : declare
+ when Attribute_Default_Iterator => Default_Iterator : declare
Func : Entity_Id;
Typ : Entity_Id;
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 "+";
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.
end if;
exception
- when No_Xref_Information => null;
+ when No_Xref_Information => null;
end;
end loop;
end Search_Xref;
projects / gcc.git / commitdiff