+2018-07-17 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * exp_ch13.adb, exp_ch7.adb, exp_unst.adb, freeze.adb,
+ libgnat/s-os_lib.adb, sem_ch3.adb, sem_ch3.ads, sem_ch5.adb,
+ sem_eval.adb, sem_res.adb, sem_util.adb: Minor reformatting.
+
2018-07-17 Javier Miranda <miranda@adacore.com>
* exp_ch13.adb (Expand_N_Freeze_Entity): Handle subtype declared for an
then
E_Scope := Scope (E_Scope);
- -- The entity may be a subtype declared for an iterator.
+ -- The entity may be a subtype declared for an iterator
elsif Ekind (E_Scope) = E_Loop then
E_Scope := Scope (E_Scope);
--------------------------------------
procedure Check_Unnesting_Elaboration_Code (N : Node_Id) is
- Loc : constant Source_Ptr := Sloc (N);
- Elab_Body : Node_Id;
- Elab_Call : Node_Id;
- Elab_Proc : Entity_Id;
- Stat : Node_Id;
+ Loc : constant Source_Ptr := Sloc (N);
+
function Contains_Subprogram (Blk : Entity_Id) return Boolean;
- -- Check recursively whether a loop or block contains a subprogram
- -- that may need an activation record.
+ -- Check recursively whether a loop or block contains a subprogram that
+ -- may need an activation record.
--------------------------
-- Contains_Subprogram --
function Contains_Subprogram (Blk : Entity_Id) return Boolean is
E : Entity_Id;
+
begin
E := First_Entity (Blk);
return False;
end Contains_Subprogram;
+ -- Local variables
+
+ Elab_Body : Node_Id;
+ Elab_Call : Node_Id;
+ Elab_Proc : Entity_Id;
+ Stat : Node_Id;
+
+ -- Start of processing for Check_Unnesting_Elaboration_Code
+
begin
if Unnest_Subprogram_Mode
and then Present (Handled_Statement_Sequence (N))
Action : Node_Id;
Par : Node_Id) return Node_Id
is
- function Within_Loop_Statement (N : Node_Id) return Boolean;
- -- Return True when N appears within a loop and no block is containing N
-
function Manages_Sec_Stack (Id : Entity_Id) return Boolean;
-- Determine whether scoping entity Id manages the secondary stack
- ---------------------------
- -- Within_Loop_Statement --
- ---------------------------
-
- function Within_Loop_Statement (N : Node_Id) return Boolean is
- Par : Node_Id := Parent (N);
-
- begin
- while not (Nkind_In (Par,
- N_Loop_Statement,
- N_Handled_Sequence_Of_Statements,
- N_Package_Specification)
- or else Nkind (Par) in N_Proper_Body)
- loop
- pragma Assert (Present (Par));
- Par := Parent (Par);
- end loop;
-
- return Nkind (Par) = N_Loop_Statement;
- end Within_Loop_Statement;
+ function Within_Loop_Statement (N : Node_Id) return Boolean;
+ -- Return True when N appears within a loop and no block is containing N
-----------------------
-- Manages_Sec_Stack --
end case;
end Manages_Sec_Stack;
+ ---------------------------
+ -- Within_Loop_Statement --
+ ---------------------------
+
+ function Within_Loop_Statement (N : Node_Id) return Boolean is
+ Par : Node_Id := Parent (N);
+
+ begin
+ while not (Nkind_In (Par, N_Handled_Sequence_Of_Statements,
+ N_Loop_Statement,
+ N_Package_Specification)
+ or else Nkind (Par) in N_Proper_Body)
+ loop
+ pragma Assert (Present (Par));
+ Par := Parent (Par);
+ end loop;
+
+ return Nkind (Par) = N_Loop_Statement;
+ end Within_Loop_Statement;
+
-- Local variables
Decls : constant List_Id := 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.
+
Subps.Append
((Ent => E,
Bod => Bod,
-- Local variables
In_Spec_Exp : constant Boolean := In_Spec_Expression;
- Typ : Entity_Id;
- Nam : Entity_Id;
- Desig_Typ : Entity_Id;
- P : Node_Id;
- Parent_P : Node_Id;
- Freeze_Outside : Boolean := False;
+ Desig_Typ : Entity_Id;
+ Nam : Entity_Id;
+ P : Node_Id;
+ Parent_P : Node_Id;
+ Typ : Entity_Id;
+
+ Freeze_Outside : Boolean := False;
-- This flag is set true if the entity must be frozen outside the
-- current subprogram. This happens in the case of expander generated
-- subprograms (_Init_Proc, _Input, _Output, _Read, _Write) which do
if not Is_Frozen (Etype (N)) then
Typ := Etype (N);
- -- Base type may be an derived numeric type that is frozen at
- -- the point of declaration, but first_subtype is still unfrozen.
+ -- Base type may be an derived numeric type that is frozen at the
+ -- point of declaration, but first_subtype is still unfrozen.
elsif not Is_Frozen (First_Subtype (Etype (N))) then
Typ := First_Subtype (Etype (N));
if Is_Array_Type (Etype (N))
and then Is_Access_Type (Component_Type (Etype (N)))
then
-
- -- Check whether aggregate includes allocators.
+ -- Check whether aggregate includes allocators
Desig_Typ := Find_Aggregate_Component_Desig_Type;
end if;
end;
end if;
- -- Examine the enclosing context by climbing the parent chain.
+ -- Examine the enclosing context by climbing the parent chain
-- If we identified that we must freeze the entity outside of a given
-- subprogram then we just climb up to that subprogram checking if some
return;
end if;
- exit when Nkind (Parent_P) = N_Subprogram_Body
- and then Unique_Defining_Entity (Parent_P) = Freeze_Outside_Subp;
+ exit when
+ Nkind (Parent_P) = N_Subprogram_Body
+ and then Unique_Defining_Entity (Parent_P) =
+ Freeze_Outside_Subp;
P := Parent_P;
end loop;
-- function call for overloading analysis purposes.
elsif Nkind (Parent (N)) = N_Function_Call
- and then
- Nkind (Parent (Parent (N))) = N_Component_Association
- and then
- First (Choices (Parent (Parent (N)))) = Parent (N)
+ and then Nkind (Parent (Parent (N))) =
+ N_Component_Association
+ and then First (Choices (Parent (Parent (N)))) =
+ Parent (N)
then
return;
end if;
return Len;
end Args_Length;
+
-----------------------------
-- Argument_String_To_List --
-----------------------------
(Arg_String : String) return Argument_List_Access
is
Max_Args : constant Integer := Arg_String'Length;
- New_Argv : Argument_List (1 .. Max_Args);
+
+ Backslash_Is_Sep : constant Boolean := Directory_Separator = '\';
+ -- Whether '\' is a directory separator (as on Windows), or a way to
+ -- quote special characters.
+
+ Backqd : Boolean := False;
Idx : Integer;
New_Argc : Natural := 0;
-
- Backqd : Boolean := False;
- Quoted : Boolean := False;
+ New_Argv : Argument_List (1 .. Max_Args);
+ Quoted : Boolean := False;
Cleaned : String (1 .. Arg_String'Length);
Cleaned_Idx : Natural;
-- A cleaned up version of the argument. This function is taking
- -- backslash escapes when computing the bounds for arguments. It is
- -- then removing the extra backslashes from the argument.
-
- Backslash_Is_Sep : constant Boolean := Directory_Separator = '\';
- -- Whether '\' is a directory separator (as on Windows), or a way to
- -- quote special characters.
+ -- backslash escapes when computing the bounds for arguments. It
+ -- is then removing the extra backslashes from the argument.
begin
Idx := Arg_String'First;
loop
-- An unquoted space is the end of an argument
- if not (Backqd or Quoted)
- and then Arg_String (Idx) = ' '
- then
+ if not (Backqd or Quoted) and then Arg_String (Idx) = ' ' then
exit;
-- Start of a quoted string
- elsif not (Backqd or Quoted)
- and then Arg_String (Idx) = '"'
- then
+ elsif not (Backqd or Quoted) and then Arg_String (Idx) = '"' then
Quoted := True;
Cleaned (Cleaned_Idx) := Arg_String (Idx);
Cleaned_Idx := Cleaned_Idx + 1;
-- End of a quoted string and end of an argument
- elsif (Quoted and not Backqd)
- and then Arg_String (Idx) = '"'
- then
+ elsif (Quoted and not Backqd) and then Arg_String (Idx) = '"' then
Cleaned (Cleaned_Idx) := Arg_String (Idx);
Cleaned_Idx := Cleaned_Idx + 1;
Idx := Idx + 1;
procedure Preanalyze_Default_Expression (N : Node_Id; T : Entity_Id) is
Save_In_Default_Expr : constant Boolean := In_Default_Expr;
Save_In_Spec_Expression : constant Boolean := In_Spec_Expression;
+
begin
In_Default_Expr := True;
In_Spec_Expression := True;
+
Preanalyze_With_Freezing_And_Resolve (N, T);
+
In_Default_Expr := Save_In_Default_Expr;
In_Spec_Expression := Save_In_Spec_Expression;
end Preanalyze_Default_Expression;
-- Always False in Ada 95 mode. Equivalent to OK_For_Limited_Init_In_05 in
-- Ada 2005 mode.
+ procedure Preanalyze_Assert_Expression (N : Node_Id; T : Entity_Id);
+ -- Wrapper on Preanalyze_Spec_Expression for assertion expressions, so that
+ -- In_Assertion_Expr can be properly adjusted.
+
procedure Preanalyze_Spec_Expression (N : Node_Id; T : Entity_Id);
-- Default and per object expressions do not freeze their components, and
-- must be analyzed and resolved accordingly. The analysis is done by
-- This mechanism is also used for aspect specifications that have an
-- expression parameter that needs similar preanalysis.
- procedure Preanalyze_Assert_Expression (N : Node_Id; T : Entity_Id);
- -- Wrapper on Preanalyze_Spec_Expression for assertion expressions, so that
- -- In_Assertion_Expr can be properly adjusted.
-
procedure Process_Full_View (N : Node_Id; Full_T, Priv_T : Entity_Id);
-- Process some semantic actions when the full view of a private type is
-- encountered and analyzed. The first action is to create the full views
and then not Is_Wrapped_In_Block (N)
then
declare
- LPS : constant Node_Id :=
- Loop_Parameter_Specification (Iter);
- DSD : constant Node_Id :=
- Original_Node (Discrete_Subtype_Definition (LPS));
- Block_Nod : Node_Id;
+ LPS : constant Node_Id := Loop_Parameter_Specification (Iter);
+ DSD : constant Node_Id :=
+ Original_Node (Discrete_Subtype_Definition (LPS));
+
Block_Id : Entity_Id;
+ Block_Nod : Node_Id;
HB : Node_Id;
LB : Node_Id;
if Nkind (DSD) = N_Subtype_Indication
and then Nkind (Range_Expression (Constraint (DSD))) = N_Range
then
- LB := New_Copy_Tree
- (Low_Bound (Range_Expression (Constraint (DSD))));
- HB := New_Copy_Tree
- (High_Bound (Range_Expression (Constraint (DSD))));
+ LB :=
+ New_Copy_Tree
+ (Low_Bound (Range_Expression (Constraint (DSD))));
+ HB :=
+ New_Copy_Tree
+ (High_Bound (Range_Expression (Constraint (DSD))));
Preanalyze (LB);
Preanalyze (HB);
if Has_Call_Using_Secondary_Stack (LB)
- or else Has_Call_Using_Secondary_Stack (HB)
+ or else Has_Call_Using_Secondary_Stack (HB)
then
Block_Nod :=
Make_Block_Statement (Loc,
- Declarations => New_List,
- Handled_Statement_Sequence =>
- Make_Handled_Sequence_Of_Statements (Loc,
- Statements => New_List (Relocate_Node (N))));
+ Declarations => New_List,
+ Handled_Statement_Sequence =>
+ Make_Handled_Sequence_Of_Statements (Loc,
+ Statements => New_List (Relocate_Node (N))));
Add_Block_Identifier (Block_Nod, Block_Id);
Set_Uses_Sec_Stack (Block_Id);
-- Check_Non_Static_Context on an expanded literal may lead to spurious
-- and misleading warnings.
- if (Nkind_In (Par, N_If_Expression, N_Case_Expression_Alternative)
+ if (Nkind_In (Par, N_Case_Expression_Alternative, N_If_Expression)
or else Nkind (Parent (N)) not in N_Subexpr)
and then (not Nkind_In (Par, N_Case_Expression_Alternative,
N_If_Expression)
-- Preanalyze_With_Freezing_And_Resolve --
------------------------------------------
- procedure Preanalyze_With_Freezing_And_Resolve (N : Node_Id; T : Entity_Id)
+ procedure Preanalyze_With_Freezing_And_Resolve
+ (N : Node_Id;
+ T : Entity_Id)
is
begin
Preanalyze_And_Resolve (N, T, With_Freezing => True);
--------------------------
function Enclosing_Subprogram (E : Entity_Id) return Entity_Id is
- Dynamic_Scope : constant Entity_Id := Enclosing_Dynamic_Scope (E);
+ Dyn_Scop : constant Entity_Id := Enclosing_Dynamic_Scope (E);
begin
- if Dynamic_Scope = Standard_Standard then
+ if Dyn_Scop = Standard_Standard then
return Empty;
- elsif Dynamic_Scope = Empty then
+ elsif Dyn_Scop = Empty then
return Empty;
- elsif Ekind (Dynamic_Scope) = E_Subprogram_Body then
- return Corresponding_Spec (Parent (Parent (Dynamic_Scope)));
+ elsif Ekind (Dyn_Scop) = E_Subprogram_Body then
+ return Corresponding_Spec (Parent (Parent (Dyn_Scop)));
- elsif Ekind_In (Dynamic_Scope, E_Block, E_Return_Statement) then
- return Enclosing_Subprogram (Dynamic_Scope);
+ elsif Ekind_In (Dyn_Scop, E_Block, E_Return_Statement) then
+ return Enclosing_Subprogram (Dyn_Scop);
- elsif Ekind (Dynamic_Scope) = E_Entry then
+ elsif Ekind (Dyn_Scop) = E_Entry then
-- For a task entry, return the enclosing subprogram of the
-- task itself.
- if Ekind (Scope (Dynamic_Scope)) = E_Task_Type then
- return Enclosing_Subprogram (Dynamic_Scope);
+ if Ekind (Scope (Dyn_Scop)) = E_Task_Type then
+ return Enclosing_Subprogram (Dyn_Scop);
- -- A protected entry is rewritten as a protected procedure
- -- which is the desired enclosing subprogram. This is relevant
- -- when unnesting a procedure local to an entry body
+ -- A protected entry is rewritten as a protected procedure which is
+ -- the desired enclosing subprogram. This is relevant when unnesting
+ -- a procedure local to an entry body.
else
- return Protected_Body_Subprogram (Dynamic_Scope);
+ return Protected_Body_Subprogram (Dyn_Scop);
end if;
- elsif Ekind (Dynamic_Scope) = E_Task_Type then
- return Get_Task_Body_Procedure (Dynamic_Scope);
+ elsif Ekind (Dyn_Scop) = E_Task_Type then
+ return Get_Task_Body_Procedure (Dyn_Scop);
-- The scope may appear as a private type or as a private extension
-- whose completion is a task or protected type.
- elsif Ekind_In (Dynamic_Scope,
- E_Limited_Private_Type, E_Record_Type_With_Private)
- and then Present (Full_View (Dynamic_Scope))
- and then Ekind_In (Full_View (Dynamic_Scope),
- E_Task_Type, E_Protected_Type)
+ elsif Ekind_In (Dyn_Scop, E_Limited_Private_Type,
+ E_Record_Type_With_Private)
+ and then Present (Full_View (Dyn_Scop))
+ and then Ekind_In (Full_View (Dyn_Scop), E_Task_Type, E_Protected_Type)
then
- return Get_Task_Body_Procedure (Full_View (Dynamic_Scope));
+ return Get_Task_Body_Procedure (Full_View (Dyn_Scop));
-- No body is generated if the protected operation is eliminated
- elsif Convention (Dynamic_Scope) = Convention_Protected
- and then not Is_Eliminated (Dynamic_Scope)
- and then Present (Protected_Body_Subprogram (Dynamic_Scope))
+ elsif Convention (Dyn_Scop) = Convention_Protected
+ and then not Is_Eliminated (Dyn_Scop)
+ and then Present (Protected_Body_Subprogram (Dyn_Scop))
then
- return Protected_Body_Subprogram (Dynamic_Scope);
+ return Protected_Body_Subprogram (Dyn_Scop);
else
- return Dynamic_Scope;
+ return Dyn_Scop;
end if;
end Enclosing_Subprogram;
Assoc := First (Governed_By);
Find_Constraint : loop
Discrim := First (Choices (Assoc));
- exit Find_Constraint when Chars (Discrim_Name) = Chars (Discrim)
- or else (Present (Corresponding_Discriminant (Entity (Discrim)))
- and then
- Chars (Corresponding_Discriminant (Entity (Discrim))) =
- Chars (Discrim_Name))
- or else Chars (Original_Record_Component (Entity (Discrim)))
- = Chars (Discrim_Name);
+ exit Find_Constraint when
+ Chars (Discrim_Name) = Chars (Discrim)
+ or else
+ (Present (Corresponding_Discriminant (Entity (Discrim)))
+ and then Chars (Corresponding_Discriminant
+ (Entity (Discrim))) = Chars (Discrim_Name))
+ or else
+ Chars (Original_Record_Component (Entity (Discrim))) =
+ Chars (Discrim_Name);
if No (Next (Assoc)) then
- if not Is_Constrained (Typ)
- and then Is_Derived_Type (Typ)
- then
+ if not Is_Constrained (Typ) and then Is_Derived_Type (Typ) then
+
-- If the type is a tagged type with inherited discriminants,
-- use the stored constraint on the parent in order to find
-- the values of discriminants that are otherwise hidden by an
-- value.
declare
- D : Entity_Id;
C : Elmt_Id;
+ D : Entity_Id;
T : Entity_Id := Typ;
begin
(New_Occurrence_Of (D, Sloc (Typ))),
Duplicate_Subexpr_No_Checks (Node (C)));
end if;
+
exit Find_Constraint;
end if;
end if;
-- Discriminant may be inherited from ancestor
+
T := Etype (T);
end loop;
end;
end if;
if No (Next (Assoc)) then
- Error_Msg_NE (" missing value for discriminant&",
- First (Governed_By), Discrim_Name);
+ Error_Msg_NE
+ (" missing value for discriminant&",
+ First (Governed_By), Discrim_Name);
+
Report_Errors := True;
return;
end if;
-----------------
function Next_Actual (Actual_Id : Node_Id) return Node_Id is
- N : Node_Id;
Par : constant Node_Id := Parent (Actual_Id);
+ N : Node_Id;
begin
-- If we are pointing at a positional parameter, it is a member of a
then
return True;
- -- Ditto for the body of a protected operation.
+ -- Ditto for the body of a protected operation
elsif Is_Subprogram (Curr)
and then Outer = Protected_Body_Subprogram (Curr)
projects / gcc.git / commitdiff