+2018-11-14 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * back_end.adb, checks.adb, exp_ch3.adb, exp_ch4.adb,
+ exp_ch7.adb, exp_disp.adb, exp_unst.adb, exp_util.adb,
+ freeze.adb, sem_ch13.adb, sem_ch6.adb, sem_ch7.adb,
+ sem_prag.adb, sem_spark.adb, sem_util.adb: Minor reformatting.
+
2018-11-14 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch4.adb (Find_Aliased_Equality): New routine.
Last : constant Natural := Switch_Last (Switch_Chars);
begin
- -- Skip -o or internal GCC switches together with their argument.
+ -- Skip -o or internal GCC switches together with their argument
if Switch_Chars (First .. Last) = "o"
or else Is_Internal_GCC_Switch (Switch_Chars)
then
Next_Arg := Next_Arg + 1;
- -- Store -G xxx as -Gxxx and go directly to the next argument.
+ -- Store -G xxx as -Gxxx and go directly to the next argument
elsif Switch_Chars (First .. Last) = "G" then
Next_Arg := Next_Arg + 1;
-- Should never get there with -G not followed by an argument,
- -- but use defensive code nonetheless.
- -- Store as -Gxxx to avoid storing parameters in ALI files that
- -- might create confusion.
+ -- but use defensive code nonetheless. Store as -Gxxx to avoid
+ -- storing parameters in ALI files that might create confusion.
if Next_Arg <= Args'Last then
Store_Compilation_Switch (Switch_Chars & Args (Next_Arg).all);
else
-- Conversions involving fixed-point types are expanded
-- separately, and do not need a Range_Check flag, except
- -- in SPARK_Mode, where the explicit constraint check will
- -- not be generated.
+ -- in GNATprove_Mode, where the explicit constraint check
+ -- will not be generated.
if GNATprove_Mode
or else not Is_Fixed_Point_Type (Expr_Type)
------------------
function Init_Formals (Typ : Entity_Id) return List_Id is
- Unc_Arr : constant Boolean :=
- Is_Array_Type (Typ) and then not Is_Constrained (Typ);
+ Loc : constant Source_Ptr := Sloc (Typ);
+ Unc_Arr : constant Boolean :=
+ Is_Array_Type (Typ) and then not Is_Constrained (Typ);
With_Prot : constant Boolean :=
- Has_Protected (Typ)
- or else (Is_Record_Type (Typ)
- and then Is_Protected_Record_Type (Typ));
+ Has_Protected (Typ)
+ or else (Is_Record_Type (Typ)
+ and then Is_Protected_Record_Type (Typ));
With_Task : constant Boolean :=
- Has_Task (Typ)
- or else (Is_Record_Type (Typ)
- and then Is_Task_Record_Type (Typ));
- Loc : constant Source_Ptr := Sloc (Typ);
+ Has_Task (Typ)
+ or else (Is_Record_Type (Typ)
+ and then Is_Task_Record_Type (Typ));
Formals : List_Id;
begin
Stmt : Node_Id;
begin
- -- We must skip SCIL nodes because they may have been added to the
- -- list by Insert_Actions.
+ -- We must skip SCIL nodes because they may have been added to the list
+ -- by Insert_Actions.
Stmt := First_Non_SCIL_Node (Stmts);
while Present (Stmt) loop
Unchecked_Convert_To (Standard_Integer, Op_Expr));
else
- -- If the modulus of the type is larger than Integer'Last
- -- use a larger type for the operands, to prevent spurious
- -- constraint errors on large legal literals of the type.
+ -- If the modulus of the type is larger than Integer'Last use a
+ -- larger type for the operands, to prevent spurious constraint
+ -- errors on large legal literals of the type.
if Modulus (Etype (N)) > UI_From_Int (Int (Integer'Last)) then
Target_Type := Standard_Long_Integer;
elsif Is_Integer_Type (Etype (N)) then
Expand_Convert_Fixed_To_Integer (N);
- -- The result of the conversion might need a range check,
- -- so do not assume that the result is in bounds.
+ -- The result of the conversion might need a range check, so do
+ -- not assume that the result is in bounds.
Set_Etype (N, Base_Type (Target_Type));
procedure Check_Unnesting_In_Declarations (N : Node_Id);
-- Similarly, the declarations in the package body may have created
- -- blocks with nested subprograms. Such a block must be transformed
- -- into a procedure followed by a call to it, so that unnesting can
- -- handle uplevel references within these nested subprograms (typically
- -- generated subprograms to handle finalization actions).
+ -- blocks with nested subprograms. Such a block must be transformed into a
+ -- procedure followed by a call to it, so that unnesting can handle uplevel
+ -- references within these nested subprograms (typically generated
+ -- subprograms to handle finalization actions).
procedure Check_Visibly_Controlled
(Prim : Final_Primitives;
procedure Check_Unnesting_In_Declarations (N : Node_Id) is
Decl : Node_Id;
+ Ent : Entity_Id;
Inner_Decl : Node_Id;
Loc : Source_Ptr;
Local_Body : Node_Id;
Local_Call : Node_Id;
-
- Ent : Entity_Id;
Local_Proc : Entity_Id;
begin
Local_Call := Empty;
+
if Unnest_Subprogram_Mode
and then Present (Declarations (N))
and then Is_Compilation_Unit (Current_Scope)
Inner_Decl := First (Declarations (Decl));
while Present (Inner_Decl) loop
-
if Nkind (Inner_Decl) = N_Subprogram_Body then
Loc := Sloc (Decl);
Local_Proc :=
Declarations => Declarations (Decl),
Handled_Statement_Sequence =>
Handled_Statement_Sequence (Decl));
+
Rewrite (Decl, Local_Body);
Analyze (Decl);
Set_Has_Nested_Subprogram (Local_Proc);
Local_Call :=
Make_Procedure_Call_Statement (Loc,
Name => New_Occurrence_Of (Local_Proc, Loc));
+
Insert_After (Decl, Local_Call);
Analyze (Local_Call);
-- to the object, because generic dispatching constructors are not
-- supported.
- if Opnd = Iface_Typ
- and then not RTE_Available (RE_Displace)
- then
+ if Opnd = Iface_Typ and then not RTE_Available (RE_Displace) then
return;
end if;
end;
(Typ : Entity_Id) return Node_Id
is
Loc : constant Source_Ptr := Sloc (Typ);
- Def_Id : constant Entity_Id :=
+ B_Id : constant Entity_Id := Make_Defining_Identifier (Loc, Name_uB);
+ Def_Id : constant Entity_Id :=
Make_Defining_Identifier (Loc,
Name_uDisp_Asynchronous_Select);
- B_Id : constant Entity_Id := Make_Defining_Identifier (Loc, Name_uB);
Params : constant List_Id := New_List;
begin
-- F : out Boolean; -- Status flag
-- The B parameter may be left uninitialized
+
Set_Warnings_Off (B_Id);
Append_List_To (Params, New_List (
procedure Register_Subprogram (E : Entity_Id; Bod : Node_Id) is
L : constant Nat := Get_Level (Subp, E);
- -- Subprograms declared in tasks and protected types cannot
- -- be eliminated because calls to them may be in other units,
- -- so they must be treated as reachable.
-
begin
- -- Subprograms declared in tasks and protected types cannot
- -- be eliminated because calls to them may be in other units,
- -- so they must be treated as reachable.
+ -- Subprograms declared in tasks and protected types cannot be
+ -- eliminated because calls to them may be in other units, so
+ -- they must be treated as reachable.
Subps.Append
((Ent => E,
return Skip;
end if;
- -- Pragmas and component declarations can be ignored.
- -- Quantified expressions are expanded into explicit loops
- -- and the original epression must be ignored.
+ -- Pragmas and component declarations are ignored. Quantified
+ -- expressions are expanded into explicit loops and the
+ -- original epression must be ignored.
when N_Component_Declaration
| N_Pragma
-- If this entity was marked reachable because it is
-- in a task or protected type, there may not appear
- -- to be any calls to it, which would normally
- -- adjust the levels of the parent subprograms.
- -- So we need to be sure that the uplevel reference
- -- of that entity takes into account possible calls.
+ -- to be any calls to it, which would normally adjust
+ -- the levels of the parent subprograms. So we need to
+ -- be sure that the uplevel reference of that entity
+ -- takes into account possible calls.
if In_Synchronized_Unit (SUBF.Ent)
and then SUBT.Lev < SUBI.Uplevel_Ref
-- We do not add types to this list, only actual references
-- to objects that will be referenced uplevel, and we use
-- the flag Is_Uplevel_Referenced_Entity to avoid making
- -- duplicate entries in the list.
- -- Discriminants are also excluded, only the enclosing
- -- object can appear in the list.
+ -- duplicate entries in the list. Discriminants are also
+ -- excluded, only the enclosing object can appear in the
+ -- list.
if not Is_Uplevel_Referenced_Entity (URJ.Ent)
and then Ekind (URJ.Ent) /= E_Discriminant
-- Declaration nodes for the AREC entities we build
begin
- -- Build list of component declarations for ARECnT
- -- and load System.Address.
+ -- Build list of component declarations for ARECnT and
+ -- load System.Address.
Clist := Empty_List;
Attr := Name_Address;
end if;
- Rhs := Make_Attribute_Reference (Loc,
- Prefix =>
- New_Occurrence_Of (Ent, Loc),
- Attribute_Name => Attr);
+ Rhs :=
+ Make_Attribute_Reference (Loc,
+ Prefix =>
+ New_Occurrence_Of (Ent, Loc),
+ Attribute_Name => Attr);
-- If the entity is an unconstrained formal
-- we wrap the attribute reference in an
if Is_Formal (Ent)
and then not Is_Constrained (Etype (Ent))
then
- -- Find target component and its type.
+ -- Find target component and its type
Comp := First_Component (STJ.ARECnT);
while Chars (Comp) /= Chars (Ent) loop
Comp := Next_Component (Comp);
end loop;
- Rhs := Unchecked_Convert_To (
- Etype (Comp), Rhs);
+ Rhs :=
+ Unchecked_Convert_To (Etype (Comp), Rhs);
end if;
Asn :=
-- If the type is tagged, the expression may be class-wide, in which
-- case it has to be converted to its root type, given that the
- -- generated predicate function is not dispatching. The conversion
- -- is type-safe and does not need validation, which matters when
- -- private extensions are involved.
+ -- generated predicate function is not dispatching. The conversion is
+ -- type-safe and does not need validation, which matters when private
+ -- extensions are involved.
if Is_Tagged_Type (Typ) then
Call :=
Set_Realval (Lo, Loval);
end if;
- -- Compute the fudged bounds. If the bound is a model number,
- -- (or greater if given low bound, smaller if high bound)
- -- then we do nothing to include it, but we are allowed to backoff
- -- to the next adjacent model number when we exclude it. If it is
- -- not a model number then we straddle the two values with the
- -- model numbers on either side.
+ -- Compute the fudged bounds. If the bound is a model number, (or
+ -- greater if given low bound, smaller if high bound) then we do
+ -- nothing to include it, but we are allowed to backoff to the
+ -- next adjacent model number when we exclude it. If it is not a
+ -- model number then we straddle the two values with the model
+ -- numbers on either side.
Model_Num := UR_Trunc (Loval / Small) * Small;
function Rep_Item_Entity (Rep_Item : Node_Id) return Entity_Id;
-- Return the entity for which Rep_Item is specified
+ --------------------------------------------------
+ -- Is_Pragma_Or_Corr_Pragma_Present_In_Rep_Item --
+ --------------------------------------------------
+
+ function Is_Pragma_Or_Corr_Pragma_Present_In_Rep_Item
+ (Rep_Item : Node_Id) return Boolean
+ is
+ begin
+ return
+ Nkind (Rep_Item) = N_Pragma
+ or else Present_In_Rep_Item
+ (Entity (Rep_Item), Aspect_Rep_Item (Rep_Item));
+ end Is_Pragma_Or_Corr_Pragma_Present_In_Rep_Item;
+
---------------------
-- Rep_Item_Entity --
---------------------
else
pragma Assert (Nkind_In (Rep_Item,
- N_Pragma,
- N_Attribute_Definition_Clause));
+ N_Attribute_Definition_Clause,
+ N_Pragma));
return Entity (Name (Rep_Item));
end if;
end Rep_Item_Entity;
- --------------------------------------------------
- -- Is_Pragma_Or_Corr_Pragma_Present_In_Rep_Item --
- --------------------------------------------------
-
- function Is_Pragma_Or_Corr_Pragma_Present_In_Rep_Item
- (Rep_Item : Node_Id) return Boolean
- is
- begin
- return
- Nkind (Rep_Item) = N_Pragma
- or else Present_In_Rep_Item
- (Entity (Rep_Item), Aspect_Rep_Item (Rep_Item));
- end Is_Pragma_Or_Corr_Pragma_Present_In_Rep_Item;
-
-- Start of processing for Inherit_Aspects_At_Freeze_Point
begin
and then Discriminal_Link (Entity (E1)) =
Discriminal_Link (Entity (E2)))
- -- AI12-050: The loop variables of quantified expressions
- -- match if they have the same identifier, even though they
- -- are different entities.
+ -- AI12-050: The loop variables of quantified expressions match
+ -- if they have the same identifier, even though they may have
+ -- different entities.
or else
(Chars (Entity (E1)) = Chars (Entity (E2))
and then Ekind (Entity (E2)) = E_Loop_Parameter)
-- A call to an instantiation of Unchecked_Conversion is
- -- rewritten with the name of the generated function
- -- created for the instance, and this must be special-cased.
+ -- rewritten with the name of the generated function created for
+ -- the instance, and this must be special-cased.
or else
(Ekind (Entity (E1)) = E_Function
Set_Is_Potentially_Use_Visible (Id);
end if;
- -- We need to avoid incorrectly marking enumeration literals
- -- as non-visible when a visible use-all-type clause is in effect.
+ -- We need to avoid incorrectly marking enumeration literals as
+ -- non-visible when a visible use-all-type clause is in effect.
elsif Type_In_Use (Etype (Id))
- and then Nkind (Current_Use_Clause (Etype (Id))) =
- N_Use_Type_Clause
- and then All_Present (Current_Use_Clause (Etype (Id)))
+ and then Nkind (Current_Use_Clause (Etype (Id))) =
+ N_Use_Type_Clause
+ and then All_Present (Current_Use_Clause (Etype (Id)))
then
null;
else
pragma Assert (Present (Global));
Error_Msg_Sloc := Sloc (Global);
- SPARK_Msg_NE ("extra global item & does not refine or " &
- "repeat any global item #", Item, Item_Id);
+ SPARK_Msg_NE
+ ("extra global item & does not refine or repeat any "
+ & "global item #", Item, Item_Id);
end if;
end if;
end Check_Refined_Global_Item;
-----------------------
procedure Check_Declaration (Decl : Node_Id) is
-
Target_Ent : constant Entity_Id := Defining_Identifier (Decl);
Target_Typ : Node_Id renames Etype (Target_Ent);
-- Single global item declaration (only input items)
- elsif Nkind_In (List, N_Expanded_Name,
- N_Identifier)
- then
+ elsif Nkind_In (List, N_Expanded_Name, N_Identifier) then
if Global_Mode = Name_Input then
return List;
else
Body_Id : Entity_Id;
begin
- pragma Assert (Nam_In (Global_Mode, Name_Input,
+ pragma Assert (Nam_In (Global_Mode, Name_In_Out,
+ Name_Input,
Name_Output,
- Name_In_Out,
Name_Proof_In));
-- Retrieve the suitable pragma Global or Refined_Global. In the second
projects / gcc.git / commitdiff