This patch is a minor cleanup in the front end. It
introduces a new subtype N_Subprogram_Call which includes
N_Function_Call and N_Procedure_Call_Statement, and then
uses this new subtype in many place in the front end
where it simplifies the code. Since there is no change
in behavior, no test is required.
Tested on x86_64-pc-linux-gnu, committed on trunk
2012-06-12 Robert Dewar <de...@adacore.com>
* sem_dist.adb, exp_ch7.adb, sem_type.adb, exp_attr.adb,
sinfo.ads, sem_ch7.adb, exp_alfa.adb, sem_scil.adb, sem_ch12.adb,
sem_util.adb, sem_res.adb, sem_attr.adb, sem_elab.adb, exp_ch6.adb,
sem_ch4.adb, sem_warn.adb, scil_ll.adb, exp_cg.adb: Minor code
reorganization.
Index: sem_dist.adb
===================================================================
--- sem_dist.adb (revision 188428)
+++ sem_dist.adb (working copy)
@@ -242,7 +242,7 @@
Par : Node_Id;
begin
- if Nkind_In (N, N_Function_Call, N_Procedure_Call_Statement)
+ if Nkind (N) in N_Subprogram_Call
and then Nkind (Name (N)) in N_Has_Entity
and then Is_Remote_Call_Interface (Entity (Name (N)))
and then Has_All_Calls_Remote (Scope (Entity (Name (N))))
Index: exp_ch7.adb
===================================================================
--- exp_ch7.adb (revision 188444)
+++ exp_ch7.adb (working copy)
@@ -4337,32 +4337,14 @@
----------------------
function Requires_Hooking return Boolean is
- function Is_Subprogram_Call (Nod : Node_Id) return Boolean;
- -- Determine whether a particular node is a procedure of function
- -- call.
-
- ------------------------
- -- Is_Subprogram_Call --
- ------------------------
-
- function Is_Subprogram_Call (Nod : Node_Id) return Boolean is
- begin
- return
- Nkind_In (Nod, N_Function_Call, N_Procedure_Call_Statement);
- end Is_Subprogram_Call;
-
- -- Start of processing for Requires_Hooking
-
begin
-- The context is either a procedure or function call or an object
- -- declaration initialized by such a call. In all these cases, the
- -- calls are assumed to raise an exception.
+ -- declaration initialized by a function call. In all these cases,
+ -- the calls might raise an exception.
- return
- Is_Subprogram_Call (N)
- or else
- (Nkind (N) = N_Object_Declaration
- and then Is_Subprogram_Call (Expression (N)));
+ return Nkind (N) in N_Subprogram_Call
+ or else (Nkind (N) = N_Object_Declaration
+ and then Nkind (Expression (N)) = N_Function_Call);
end Requires_Hooking;
-- Local variables
Index: sem_type.adb
===================================================================
--- sem_type.adb (revision 188428)
+++ sem_type.adb (working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -481,7 +481,7 @@
then
Add_Entry (Entity (N), Etype (N));
- elsif Nkind_In (N, N_Function_Call, N_Procedure_Call_Statement)
+ elsif Nkind (N) in N_Subprogram_Call
and then Is_Entity_Name (Name (N))
then
Add_Entry (Entity (Name (N)), Etype (N));
@@ -1467,9 +1467,7 @@
return It1;
else
- if Nkind (N) = N_Function_Call
- or else Nkind (N) = N_Procedure_Call_Statement
- then
+ if Nkind (N) in N_Subprogram_Call then
Act1 := First_Actual (N);
if Present (Act1) then
@@ -1867,8 +1865,7 @@
elsif In_Instance
and then not In_Generic_Actual (N)
then
- if Nkind (N) = N_Function_Call
- or else Nkind (N) = N_Procedure_Call_Statement
+ if Nkind (N) in N_Subprogram_Call
or else
(Nkind (N) in N_Has_Entity
and then
Index: exp_attr.adb
===================================================================
--- exp_attr.adb (revision 188428)
+++ exp_attr.adb (working copy)
@@ -421,7 +421,7 @@
Par := Parent (Par);
end if;
- if Nkind_In (Par, N_Procedure_Call_Statement, N_Function_Call)
+ if Nkind (Par) in N_Subprogram_Call
and then Is_Entity_Name (Name (Par))
then
Subp := Entity (Name (Par));
Index: sinfo.ads
===================================================================
--- sinfo.ads (revision 188428)
+++ sinfo.ads (working copy)
@@ -7649,11 +7649,17 @@
N_Conditional_Expression,
N_Explicit_Dereference,
N_Expression_With_Actions,
+
+ -- N_Subexpr, N_Has_Etype, N_Subprogram_Call
+
N_Function_Call,
+ N_Procedure_Call_Statement,
+
+ -- N_Subexpr, N_Has_Etype
+
N_Indexed_Component,
N_Integer_Literal,
N_Null,
- N_Procedure_Call_Statement,
N_Qualified_Expression,
N_Quantified_Expression,
@@ -8067,6 +8073,10 @@
-- (since overloading is possible, so it needs to go through the normal
-- overloading resolution for expressions).
+ subtype N_Subprogram_Call is Node_Kind range
+ N_Function_Call ..
+ N_Procedure_Call_Statement;
+
subtype N_Subprogram_Instantiation is Node_Kind range
N_Function_Instantiation ..
N_Procedure_Instantiation;
Index: sem_ch7.adb
===================================================================
--- sem_ch7.adb (revision 188441)
+++ sem_ch7.adb (working copy)
@@ -533,7 +533,7 @@
begin
-- Check name of procedure or function calls
- if Nkind_In (N, N_Procedure_Call_Statement, N_Function_Call)
+ if Nkind (N) in N_Subprogram_Call
and then Is_Entity_Name (Name (N))
then
return Abandon;
Index: exp_alfa.adb
===================================================================
--- exp_alfa.adb (revision 188428)
+++ exp_alfa.adb (working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -87,8 +87,7 @@
N_Subprogram_Body =>
Qualify_Entity_Names (N);
- when N_Function_Call |
- N_Procedure_Call_Statement =>
+ when N_Subprogram_Call =>
Expand_Alfa_Call (N);
when N_Expanded_Name |
Index: sem_scil.adb
===================================================================
--- sem_scil.adb (revision 188428)
+++ sem_scil.adb (working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2009-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 2009-2012, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -59,10 +59,7 @@
-- Parent of SCIL dispatching call nodes MUST be a subprogram call
- if not Nkind_In (N, N_Function_Call,
- N_Procedure_Call_Statement)
- then
- pragma Assert (False);
+ if Nkind (N) not in N_Subprogram_Call then
raise Program_Error;
-- In simple cases the controlling tag is the tag of the
Index: sem_ch12.adb
===================================================================
--- sem_ch12.adb (revision 188443)
+++ sem_ch12.adb (working copy)
@@ -13578,9 +13578,7 @@
-- information on aggregates in instances.
if Nkind (N2) = Nkind (N)
- and then
- Nkind_In (Parent (N2), N_Procedure_Call_Statement,
- N_Function_Call)
+ and then Nkind (Parent (N2)) in N_Subprogram_Call
and then Comes_From_Source (Typ)
then
if Is_Immediately_Visible (Scope (Typ)) then
Index: sem_util.adb
===================================================================
--- sem_util.adb (revision 188434)
+++ sem_util.adb (working copy)
@@ -3747,7 +3747,7 @@
then
Call := Parent (Parnt);
- elsif Nkind_In (Parnt, N_Procedure_Call_Statement, N_Function_Call) then
+ elsif Nkind (Parnt) in N_Subprogram_Call then
Call := Parnt;
else
@@ -6604,7 +6604,7 @@
when N_Parameter_Association =>
return N = Explicit_Actual_Parameter (Parent (N));
- when N_Function_Call | N_Procedure_Call_Statement =>
+ when N_Subprogram_Call =>
return Is_List_Member (N)
and then
List_Containing (N) = Parameter_Associations (Parent (N));
@@ -8127,9 +8127,8 @@
function Is_Remote_Call (N : Node_Id) return Boolean is
begin
- if Nkind (N) /= N_Procedure_Call_Statement
- and then Nkind (N) /= N_Function_Call
- then
+ if Nkind (N) not in N_Subprogram_Call then
+
-- An entry call cannot be remote
return False;
@@ -9328,9 +9327,8 @@
-- In older versions of Ada function call arguments are never
-- lvalues. In Ada 2012 functions can have in-out parameters.
- when N_Function_Call |
- N_Procedure_Call_Statement |
- N_Entry_Call_Statement |
+ when N_Subprogram_Call |
+ N_Entry_Call_Statement |
N_Accept_Statement
=>
if Nkind (P) = N_Function_Call and then Ada_Version < Ada_2012 then
Index: sem_res.adb
===================================================================
--- sem_res.adb (revision 188438)
+++ sem_res.adb (working copy)
@@ -2144,9 +2144,7 @@
-- of the arguments is Any_Type, and if so, suppress
-- the message, since it is a cascaded error.
- if Nkind_In (N, N_Function_Call,
- N_Procedure_Call_Statement)
- then
+ if Nkind (N) in N_Subprogram_Call then
declare
A : Node_Id;
E : Node_Id;
@@ -2212,8 +2210,7 @@
("\\possible interpretation#!", N);
end if;
- if Nkind_In
- (N, N_Procedure_Call_Statement, N_Function_Call)
+ if Nkind (N) in N_Subprogram_Call
and then Present (Parameter_Associations (N))
then
Report_Ambiguous_Argument;
@@ -2360,7 +2357,7 @@
-- For procedure or function calls, set the type of the name,
-- and also the entity pointer for the prefix.
- elsif Nkind_In (N, N_Procedure_Call_Statement, N_Function_Call)
+ elsif Nkind (N) in N_Subprogram_Call
and then Is_Entity_Name (Name (N))
then
Set_Etype (Name (N), Expr_Type);
@@ -2990,8 +2987,7 @@
if not Warn_On_Parameter_Order
or else No (Parameter_Associations (N))
- or else not Nkind_In (Original_Node (N), N_Procedure_Call_Statement,
- N_Function_Call)
+ or else Nkind (Original_Node (N)) not in N_Subprogram_Call
or else not Comes_From_Source (N)
then
return;
@@ -4223,11 +4219,9 @@
Par : constant Node_Id := Parent (N);
begin
- return
- Nkind_In (Par, N_Function_Call,
- N_Procedure_Call_Statement)
- and then Is_Entity_Name (Name (Par))
- and then Is_Dispatching_Operation (Entity (Name (Par)));
+ return Nkind (Par) in N_Subprogram_Call
+ and then Is_Entity_Name (Name (Par))
+ and then Is_Dispatching_Operation (Entity (Name (Par)));
end In_Dispatching_Context;
-- Start of processing for Resolve_Allocator
@@ -7749,9 +7743,7 @@
-- In the common case of a call which uses an explicitly null value
-- for an access parameter, give specialized error message.
- if Nkind_In (Parent (N), N_Procedure_Call_Statement,
- N_Function_Call)
- then
+ if Nkind (Parent (N)) in N_Subprogram_Call then
Error_Msg_N
("null is not allowed as argument for an access parameter", N);
Index: sem_attr.adb
===================================================================
--- sem_attr.adb (revision 188428)
+++ sem_attr.adb (working copy)
@@ -3849,8 +3849,7 @@
-- Case of attribute used as actual for subprogram (positional)
- elsif Nkind_In (Parnt, N_Procedure_Call_Statement,
- N_Function_Call)
+ elsif Nkind (Parnt) in N_Subprogram_Call
and then Is_Entity_Name (Name (Parnt))
then
Must_Be_Imported (Entity (Name (Parnt)));
@@ -3858,8 +3857,7 @@
-- Case of attribute used as actual for subprogram (named)
elsif Nkind (Parnt) = N_Parameter_Association
- and then Nkind_In (GParnt, N_Procedure_Call_Statement,
- N_Function_Call)
+ and then Nkind (GParnt) in N_Subprogram_Call
and then Is_Entity_Name (Name (GParnt))
then
Must_Be_Imported (Entity (Name (GParnt)));
Index: sem_elab.adb
===================================================================
--- sem_elab.adb (revision 188428)
+++ sem_elab.adb (working copy)
@@ -545,8 +545,7 @@
-- If the call is known to be within a local Suppress Elaboration
-- pragma, nothing to check. This can happen in task bodies.
- if (Nkind (N) = N_Function_Call
- or else Nkind (N) = N_Procedure_Call_Statement)
+ if Nkind (N) in N_Subprogram_Call
and then No_Elaboration_Check (N)
then
return;
@@ -990,9 +989,7 @@
-- which can happen if the body enclosing the call appears
-- itself in a call whose elaboration check is delayed.
- if Nkind_In (N, N_Function_Call,
- N_Procedure_Call_Statement)
- then
+ if Nkind (N) in N_Subprogram_Call then
Set_No_Elaboration_Check (N);
end if;
end if;
@@ -1184,8 +1181,7 @@
-- Nothing to do if this is not a call or attribute reference (happens
-- in some error conditions, and in some cases where rewriting occurs).
- elsif Nkind (N) /= N_Function_Call
- and then Nkind (N) /= N_Procedure_Call_Statement
+ elsif Nkind (N) not in N_Subprogram_Call
and then Nkind (N) /= N_Attribute_Reference
then
return;
@@ -1510,8 +1506,7 @@
Func : Entity_Id;
begin
- if (Nkind (Nod) = N_Function_Call
- or else Nkind (Nod) = N_Procedure_Call_Statement)
+ if Nkind (Nod) in N_Subprogram_Call
and then Is_Entity_Name (Name (Nod))
then
Func := Entity (Name (Nod));
Index: exp_ch6.adb
===================================================================
--- exp_ch6.adb (revision 188428)
+++ exp_ch6.adb (working copy)
@@ -3271,7 +3271,7 @@
-- Ada 2005 (AI-251): If some formal is a class-wide interface, expand
-- it to point to the correct secondary virtual table
- if Nkind_In (Call_Node, N_Function_Call, N_Procedure_Call_Statement)
+ if Nkind (Call_Node) in N_Subprogram_Call
and then CW_Interface_Formals_Present
then
Expand_Interface_Actuals (Call_Node);
@@ -3285,7 +3285,7 @@
-- back-ends directly handle the generation of dispatching calls and
-- would have to undo any expansion to an indirect call.
- if Nkind_In (Call_Node, N_Function_Call, N_Procedure_Call_Statement)
+ if Nkind (Call_Node) in N_Subprogram_Call
and then Present (Controlling_Argument (Call_Node))
then
declare
@@ -3868,13 +3868,14 @@
-- intermediate result after its use.
elsif Is_Build_In_Place_Function_Call (Call_Node)
- and then Nkind_In (Parent (Call_Node), N_Attribute_Reference,
- N_Function_Call,
- N_Indexed_Component,
- N_Object_Renaming_Declaration,
- N_Procedure_Call_Statement,
- N_Selected_Component,
- N_Slice)
+ and then
+ Nkind_In (Parent (Call_Node), N_Attribute_Reference,
+ N_Function_Call,
+ N_Indexed_Component,
+ N_Object_Renaming_Declaration,
+ N_Procedure_Call_Statement,
+ N_Selected_Component,
+ N_Slice)
then
Establish_Transient_Scope (Call_Node, Sec_Stack => True);
end if;
Index: sem_ch4.adb
===================================================================
--- sem_ch4.adb (revision 188441)
+++ sem_ch4.adb (working copy)
@@ -2299,7 +2299,7 @@
Analyze (P);
- if Nkind_In (N, N_Function_Call, N_Procedure_Call_Statement) then
+ if Nkind (N) in N_Subprogram_Call then
-- If P is an explicit dereference whose prefix is of a
-- remote access-to-subprogram type, then N has already
@@ -6736,9 +6736,7 @@
(N : Node_Id; CW_Test_Only : Boolean := False) return Boolean
is
K : constant Node_Kind := Nkind (Parent (N));
- Is_Subprg_Call : constant Boolean := Nkind_In
- (K, N_Procedure_Call_Statement,
- N_Function_Call);
+ Is_Subprg_Call : constant Boolean := K in N_Subprogram_Call;
Loc : constant Source_Ptr := Sloc (N);
Obj : constant Node_Id := Prefix (N);
@@ -7087,8 +7085,7 @@
-- Common case covering 1) Call to a procedure and 2) Call to a
-- function that has some additional actuals.
- if Nkind_In (Parent_Node, N_Function_Call,
- N_Procedure_Call_Statement)
+ if Nkind (Parent_Node) in N_Subprogram_Call
-- N is a selected component node containing the name of the
-- subprogram. If N is not the name of the parent node we must
Index: sem_warn.adb
===================================================================
--- sem_warn.adb (revision 188428)
+++ sem_warn.adb (working copy)
@@ -511,9 +511,8 @@
-- Call to subprogram
- elsif Nkind (N) = N_Procedure_Call_Statement
- or else Nkind (N) = N_Function_Call
- then
+ elsif Nkind (N) in N_Subprogram_Call then
+
-- If subprogram is within the scope of the entity we are dealing
-- with as the loop variable, then it could modify this parameter,
-- so we abandon in this case. In the case of a subprogram that is
@@ -3282,7 +3281,7 @@
-- Exclude calls rewritten as enumeration literals
- if not Nkind_In (N, N_Function_Call, N_Procedure_Call_Statement) then
+ if Nkind (N) not in N_Subprogram_Call then
return;
end if;
Index: scil_ll.adb
===================================================================
--- scil_ll.adb (revision 188428)
+++ scil_ll.adb (working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2010, Free Software Foundation, Inc. --
+-- Copyright (C) 2010-2012, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -117,8 +117,7 @@
null;
when N_SCIL_Dispatching_Call =>
- pragma Assert (Nkind_In (N, N_Function_Call,
- N_Procedure_Call_Statement));
+ pragma Assert (Nkind (N) in N_Subprogram_Call);
null;
when N_SCIL_Membership_Test =>
Index: exp_cg.adb
===================================================================
--- exp_cg.adb (revision 188428)
+++ exp_cg.adb (working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2010, Free Software Foundation, Inc. --
+-- Copyright (C) 2010-2012, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -122,7 +122,7 @@
for J in Call_Graph_Nodes.First .. Call_Graph_Nodes.Last loop
N := Call_Graph_Nodes.Table (J);
- if Nkind_In (N, N_Procedure_Call_Statement, N_Function_Call) then
+ if Nkind (N) in N_Subprogram_Call then
Write_Call_Info (N);
else pragma Assert (Nkind (N) = N_Defining_Identifier);
@@ -349,7 +349,7 @@
procedure Register_CG_Node (N : Node_Id) is
begin
- if Nkind_In (N, N_Procedure_Call_Statement, N_Function_Call) then
+ if Nkind (N) in N_Subprogram_Call then
if Current_Scope = Main_Unit_Entity
or else Entity_Is_In_Main_Unit (Current_Scope)
then
