-- 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)];
--
-- 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
-- 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.
--------------------
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;
-- 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);
-- 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);
-- 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
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
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
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);
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
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;
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;
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;
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
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);
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;
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
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
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
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
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
projects / gcc.git / commitdiff