Commit ec40b86c by Hristian Kirtchev Committed by Arnaud Charlet

sem_prag.adb, [...]: Minor reformatting.

2017-04-25  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_prag.adb, exp_ch6.adb, binde.adb, sem_disp.adb, s-fileio.adb:
	Minor reformatting.

From-SVN: r247179
parent ca1f6b29
2017-04-25 Hristian Kirtchev <kirtchev@adacore.com>
* sem_prag.adb, exp_ch6.adb, binde.adb, sem_disp.adb, s-fileio.adb:
Minor reformatting.
2017-04-25 Bob Duff <duff@adacore.com>
* sem_prag.adb (No_Return): Give an error if the pragma applies
......
......@@ -2235,7 +2235,7 @@ package body Binde is
begin
while S /= No_Successor loop
if UNR.Table (Succ.Table (S).After).Elab_Position <=
UNR.Table (U).Elab_Position
UNR.Table (U).Elab_Position
then
OK := False;
Write_Line (Msg & " elab order failed");
......
......@@ -159,14 +159,16 @@ package body Exp_Ch6 is
-- we have an infinite recursion.
procedure Expand_Actuals
(N : Node_Id; Subp : Entity_Id; Post_Call : out List_Id);
-- Return in Post_Call a list of actions to take place after the call.
-- The call will later be rewritten as an Expression_With_Actions,
-- with the Post_Call actions inserted, and the call inside.
(N : Node_Id;
Subp : Entity_Id;
Post_Call : out List_Id);
-- Return a list of actions to take place after the call in Post_Call. The
-- call will later be rewritten as an Expression_With_Actions, with the
-- Post_Call actions inserted, and the call inside.
--
-- For each actual of an in-out or out parameter which is a numeric
-- (view) conversion of the form T (A), where A denotes a variable,
-- we insert the declaration:
-- For each actual of an in-out or out parameter which is a numeric (view)
-- conversion of the form T (A), where A denotes a variable, we insert the
-- declaration:
--
-- Temp : T[ := T (A)];
--
......@@ -197,12 +199,7 @@ package body Exp_Ch6 is
-- based on the predicates of the actual type.
procedure Expand_Call_Helper (N : Node_Id; Post_Call : out List_Id);
-- Does the main work of Expand_Call. Post_Call is as for Expand_Actuals
procedure Insert_Post_Call_Actions
(N : Node_Id; Post_Call : List_Id);
-- Insert the Post_Call list (previously produced by
-- Expand_Actuals/Expand_Call_Helper) into the tree.
-- Does the main work of Expand_Call. Post_Call is as for Expand_Actuals.
procedure Expand_Ctrl_Function_Call (N : Node_Id);
-- N is a function call which returns a controlled object. Transform the
......@@ -236,6 +233,10 @@ package body Exp_Ch6 is
-- Returns True if the given subtype is unconstrained and has one or more
-- access discriminants.
procedure Insert_Post_Call_Actions (N : Node_Id; Post_Call : List_Id);
-- Insert the Post_Call list previously produced by routine Expand_Actuals
-- or Expand_Call_Helper into the tree.
procedure Rewrite_Function_Call_For_C (N : Node_Id);
-- When generating C code, replace a call to a function that returns an
-- array into the generated procedure with an additional out parameter.
......@@ -1155,7 +1156,9 @@ package body Exp_Ch6 is
--------------------
procedure Expand_Actuals
(N : Node_Id; Subp : Entity_Id; Post_Call : out List_Id)
(N : Node_Id;
Subp : Entity_Id;
Post_Call : out List_Id)
is
Loc : constant Source_Ptr := Sloc (N);
Actual : Node_Id;
......@@ -7220,27 +7223,24 @@ package body Exp_Ch6 is
-- Insert_Post_Call_Actions --
------------------------------
procedure Insert_Post_Call_Actions
(N : Node_Id; Post_Call : List_Id)
is
procedure Insert_Post_Call_Actions (N : Node_Id; Post_Call : List_Id) is
begin
if Is_Empty_List (Post_Call) then
return;
end if;
-- Cases where the call is not a member of a statement list.
-- This includes the case where the call is an actual in another
-- function call or indexing, i.e. an expression context as well.
-- Cases where the call is not a member of a statement list. This
-- includes the case where the call is an actual in another function
-- call or indexing, i.e. an expression context as well.
if not Is_List_Member (N)
or else Nkind_In (Parent (N), N_Function_Call, N_Indexed_Component)
then
-- In Ada 2012 the call may be a function call in an expression
-- (since OUT and IN OUT parameters are now allowed for such
-- calls). The write-back of (in)-out parameters is handled
-- by the back-end, but the constraint checks generated when
-- subtypes of formal and actual don't match must be inserted
-- in the form of assignments.
-- (since OUT and IN OUT parameters are now allowed for such calls).
-- The write-back of (in)-out parameters is handled by the back-end,
-- but the constraint checks generated when subtypes of formal and
-- actual don't match must be inserted in the form of assignments.
if Nkind (Original_Node (N)) = N_Function_Call then
pragma Assert (Ada_Version >= Ada_2012);
......@@ -7252,8 +7252,8 @@ package body Exp_Ch6 is
-- Insert_Actions_After (P, Post_Call), but that doesn't work
-- for Ada 2012. If we are in the middle of an expression, e.g.
-- the condition of an IF, this call would insert after the IF
-- statement, which is much too late to be doing the write
-- back. For example:
-- statement, which is much too late to be doing the write back.
-- For example:
-- if Clobber (X) then
-- Put_Line (X'Img);
......@@ -7261,9 +7261,9 @@ package body Exp_Ch6 is
-- goto Junk
-- end if;
-- Now assume Clobber changes X, if we put the write back
-- after the IF, the Put_Line gets the wrong value and the
-- goto causes the write back to be skipped completely.
-- Now assume Clobber changes X, if we put the write back after
-- the IF, the Put_Line gets the wrong value and the goto causes
-- the write back to be skipped completely.
-- To deal with this, we replace the call by
......@@ -7304,10 +7304,10 @@ package body Exp_Ch6 is
Set_Analyzed (Name, False);
end;
-- If not the special Ada 2012 case of a function call, then
-- we must have the triggering statement of a triggering
-- alternative or an entry call alternative, and we can add
-- the post call stuff to the corresponding statement list.
-- If not the special Ada 2012 case of a function call, then we must
-- have the triggering statement of a triggering alternative or an
-- entry call alternative, and we can add the post call stuff to the
-- corresponding statement list.
else
declare
......@@ -7315,8 +7315,8 @@ package body Exp_Ch6 is
begin
P := Parent (N);
pragma Assert (Nkind_In (P, N_Triggering_Alternative,
N_Entry_Call_Alternative));
pragma Assert (Nkind_In (P, N_Entry_Call_Alternative,
N_Triggering_Alternative));
if Is_Non_Empty_List (Statements (P)) then
Insert_List_Before_And_Analyze
......@@ -7327,8 +7327,8 @@ package body Exp_Ch6 is
end;
end if;
-- Otherwise, normal case where N is in a statement sequence,
-- just put the post-call stuff after the call statement.
-- Otherwise, normal case where N is in a statement sequence, just put
-- the post-call stuff after the call statement.
else
Insert_Actions_After (N, Post_Call);
......
......@@ -296,14 +296,15 @@ package body System.File_IO is
Temp : access Temp_File_Record_Ptr := Temp_Files'Access;
-- Note the double indirection here
Discard : int;
New_Temp : Temp_File_Record_Ptr;
Discard : int;
begin
while Temp.all.all.File /= File loop
Temp := Temp.all.all.Next'Access;
end loop;
Discard := unlink (Temp.all.all.Name'Address);
Discard := unlink (Temp.all.all.Name'Address);
New_Temp := Temp.all.all.Next;
Free (Temp.all);
Temp.all := New_Temp;
......
......@@ -967,8 +967,8 @@ package body Sem_Disp is
Error_Msg_Name_2 := Chars (E);
Error_Msg_Sloc := Sloc (E);
Error_Msg_N
("?j?primitive of type % defined after private " &
"extension % #?", Prim);
("?j?primitive of type % defined after private extension "
& "% #?", Prim);
Error_Msg_Name_1 := Chars (Prim);
Error_Msg_Name_2 := Chars (E);
Error_Msg_N
......@@ -989,6 +989,8 @@ package body Sem_Disp is
Ovr_Subp : Entity_Id := Empty;
Tagged_Type : Entity_Id;
-- Start of processing for Check_Dispatching_Operation
begin
if not Ekind_In (Subp, E_Function, E_Procedure) then
return;
......@@ -1080,8 +1082,8 @@ package body Sem_Disp is
then
Error_Msg_N ("??declaration of& is too late!", Subp);
Error_Msg_NE -- CODEFIX??
("\??spec should appear immediately after declaration "
& "of & !", Subp, Typ);
("\??spec should appear immediately after declaration of "
& "& !", Subp, Typ);
exit;
end if;
......@@ -1109,8 +1111,8 @@ package body Sem_Disp is
then
Error_Msg_N ("??declaration of& is too late!", Subp);
Error_Msg_NE
("\??spec should appear immediately after declaration "
& "of & !", Subp, Typ);
("\??spec should appear immediately after declaration of "
& "& !", Subp, Typ);
end if;
end if;
end;
......
......@@ -4219,9 +4219,9 @@ package body Sem_Prag is
function Inherits_Class_Wide_Pre (E : Entity_Id) return Boolean is
Typ : constant Entity_Id := Find_Dispatching_Type (E);
Prev : Entity_Id := Overridden_Operation (E);
Cont : Node_Id;
Prag : Node_Id;
Prev : Entity_Id := Overridden_Operation (E);
begin
-- Check ancestors on the overriding operation to examine the
......@@ -4240,9 +4240,9 @@ package body Sem_Prag is
end loop;
end if;
-- For a type derived from a generic formal type, the
-- operation inheriting the condition is a renaming, not
-- an overriding of the operation of the formal.
-- For a type derived from a generic formal type, the operation
-- inheriting the condition is a renaming, not an overriding of
-- the operation of the formal.
if Is_Generic_Type (Find_Dispatching_Type (Prev)) then
Prev := Alias (Prev);
......@@ -7399,20 +7399,21 @@ package body Sem_Prag is
or else Ekind (E) = E_Variable
-- A component as well. The entity does not have its
-- Ekind set until the enclosing record declaration is
-- fully analyzed.
-- A component as well. The entity does not have its Ekind
-- set until the enclosing record declaration is fully
-- analyzed.
or else Nkind (Parent (E)) = N_Component_Declaration
-- An access to subprogram is also allowed
or else (Is_Access_Type (E)
and then Ekind (Designated_Type (E)) = E_Subprogram_Type)
or else
(Is_Access_Type (E)
and then Ekind (Designated_Type (E)) = E_Subprogram_Type)
-- Allow internal call to set convention of subprogram type
or else (Ekind (E) = E_Subprogram_Type)
or else Ekind (E) = E_Subprogram_Type
then
null;
......@@ -8084,8 +8085,8 @@ package body Sem_Prag is
N_Subprogram_Body
then
Error_Pragma
("pragma% requires separate spec" &
" and must come before body");
("pragma% requires separate spec and must come before "
& "body");
end if;
-- Test result type if given, note that the result type
......@@ -8097,14 +8098,14 @@ package body Sem_Prag is
Match := False;
elsif Etype (Def_Id) /= Standard_Void_Type
and then
Nam_In (Pname, Name_Export_Procedure, Name_Import_Procedure)
and then Nam_In (Pname, Name_Export_Procedure,
Name_Import_Procedure)
then
Match := False;
-- Test parameter types if given. Note that this parameter
-- has not been analyzed (and must not be, since it is
-- semantic nonsense), so we get it as the parser left it.
-- Test parameter types if given. Note that this parameter has
-- not been analyzed (and must not be, since it is semantic
-- nonsense), so we get it as the parser left it.
elsif Present (Arg_Parameter_Types) then
Check_Matching_Types : declare
......@@ -8119,8 +8120,8 @@ package body Sem_Prag is
Match := False;
end if;
-- A list of one type, e.g. (List) is parsed as
-- a parenthesized expression.
-- A list of one type, e.g. (List) is parsed as a
-- parenthesized expression.
elsif Nkind (Arg_Parameter_Types) /= N_Aggregate
and then Paren_Count (Arg_Parameter_Types) = 1
......@@ -18176,7 +18177,8 @@ package body Sem_Prag is
while Present (E)
and then Scope (E) = Current_Scope
loop
if Ekind_In (E, E_Procedure, E_Generic_Procedure) then
if Ekind_In (E, E_Generic_Procedure, E_Procedure) then
-- Check that the pragma is not applied to a body.
-- First check the specless body case, to give a
-- different error message. These checks do not apply
......@@ -18189,8 +18191,8 @@ package body Sem_Prag is
and then not Relaxed_RM_Semantics
then
Error_Pragma
("pragma% requires separate spec" &
" and must come before body");
("pragma% requires separate spec and must come "
& "before body");
end if;
-- Now the "specful" body case
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