From: Piotr Trojanek <troja...@adacore.com>
Instead of using the generic routine Traverse_Proc to set a global flag when a
particular node is found, we can use its underlying routine Traverse_Func and
check if traversal has been abandoned. We already used this pattern in a number
of places; this patch merely applies it the remaining uses of Traverse_Proc.
Code cleanup; semantics is unaffected.
gcc/ada/ChangeLog:
* exp_ch3.adb (Search_Access_Discriminant, Search_Current_Instance,
Search_Internal_Call): Use traversal function instead of traversal
procedure and remove associated global variables.
* exp_util.adb (Search_Calls): Likewise.
* sem_prag.adb (Contains_Loop_Entry): Likewise.
* sem_util.adb (Mentions_Post_State): Likewise.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/exp_ch3.adb | 67 ++++++++++++++++++--------------------------
gcc/ada/exp_util.adb | 11 ++------
gcc/ada/sem_prag.adb | 8 ++----
gcc/ada/sem_util.adb | 15 +++-------
4 files changed, 35 insertions(+), 66 deletions(-)
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index afcb0a9d328..71bca1cdc88 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -10406,63 +10406,57 @@ package body Exp_Ch3 is
(Decl : Node_Id;
Rec_Type : Entity_Id) return Boolean
is
- References_Current_Instance : Boolean := False;
- Has_Access_Discriminant : Boolean := False;
- Has_Internal_Call : Boolean := False;
-
- function Find_Access_Discriminant
+ function Is_Access_Discriminant
(N : Node_Id) return Traverse_Result;
-- Look for a name denoting an access discriminant
- function Find_Current_Instance
+ function Is_Current_Instance
(N : Node_Id) return Traverse_Result;
-- Look for a reference to the current instance of the type
- function Find_Internal_Call
+ function Is_Internal_Call
(N : Node_Id) return Traverse_Result;
-- Look for an internal protected function call
- ------------------------------
- -- Find_Access_Discriminant --
- ------------------------------
+ ----------------------------
+ -- Is_Access_Discriminant --
+ ----------------------------
- function Find_Access_Discriminant
+ function Is_Access_Discriminant
(N : Node_Id) return Traverse_Result is
begin
if Is_Entity_Name (N)
and then Denotes_Discriminant (N)
and then Is_Access_Type (Etype (N))
then
- Has_Access_Discriminant := True;
return Abandon;
else
return OK;
end if;
- end Find_Access_Discriminant;
+ end Is_Access_Discriminant;
- ---------------------------
- -- Find_Current_Instance --
- ---------------------------
+ -------------------------
+ -- Is_Current_Instance --
+ -------------------------
- function Find_Current_Instance
+ function Is_Current_Instance
(N : Node_Id) return Traverse_Result is
begin
if Is_Entity_Name (N)
and then Present (Entity (N))
and then Is_Current_Instance (N)
then
- References_Current_Instance := True;
return Abandon;
else
return OK;
end if;
- end Find_Current_Instance;
+ end Is_Current_Instance;
- ------------------------
- -- Find_Internal_Call --
- ------------------------
+ ----------------------
+ -- Is_Internal_Call --
+ ----------------------
- function Find_Internal_Call (N : Node_Id) return Traverse_Result is
+ function Is_Internal_Call (N : Node_Id) return Traverse_Result is
function Call_Scope (N : Node_Id) return Entity_Id;
-- Return the scope enclosing a given call node N
@@ -10486,21 +10480,20 @@ package body Exp_Ch3 is
and then Call_Scope (N)
= Corresponding_Concurrent_Type (Rec_Type)
then
- Has_Internal_Call := True;
return Abandon;
else
return OK;
end if;
- end Find_Internal_Call;
+ end Is_Internal_Call;
- procedure Search_Access_Discriminant is new
- Traverse_Proc (Find_Access_Discriminant);
+ function Search_Access_Discriminant is new
+ Traverse_Func (Is_Access_Discriminant);
- procedure Search_Current_Instance is new
- Traverse_Proc (Find_Current_Instance);
+ function Search_Current_Instance is new
+ Traverse_Func (Is_Current_Instance);
- procedure Search_Internal_Call is new
- Traverse_Proc (Find_Internal_Call);
+ function Search_Internal_Call is new
+ Traverse_Func (Is_Internal_Call);
-- Start of processing for Requires_Late_Init
@@ -10521,9 +10514,7 @@ package body Exp_Ch3 is
-- it has an initialization expression that includes a name
-- denoting an access discriminant;
- Search_Access_Discriminant (Expression (Decl));
-
- if Has_Access_Discriminant then
+ if Search_Access_Discriminant (Expression (Decl)) = Abandon then
return True;
end if;
@@ -10531,18 +10522,14 @@ package body Exp_Ch3 is
-- reference to the current instance of the type either by
-- name...
- Search_Current_Instance (Expression (Decl));
-
- if References_Current_Instance then
+ if Search_Current_Instance (Expression (Decl)) = Abandon then
return True;
end if;
-- ...or implicitly as the target object of a call.
if Is_Protected_Record_Type (Rec_Type) then
- Search_Internal_Call (Expression (Decl));
-
- if Has_Internal_Call then
+ if Search_Internal_Call (Expression (Decl)) = Abandon then
return True;
end if;
end if;
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index e449d45cdfd..b9a9b5ff953 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -5848,10 +5848,6 @@ package body Exp_Util is
is
U_Typ : constant Entity_Id := Unique_Entity (Typ);
- Calls_OK : Boolean := False;
- -- This flag is set to True when expression Expr contains at least one
- -- call to a nondispatching primitive function of Typ.
-
function Search_Primitive_Calls (N : Node_Id) return Traverse_Result;
-- Search for nondispatching calls to primitive functions of type Typ
@@ -5886,8 +5882,6 @@ package body Exp_Util is
if Present (Disp_Typ)
and then Unique_Entity (Disp_Typ) = U_Typ
then
- Calls_OK := True;
-
-- There is no need to continue the traversal, as one such
-- call suffices.
@@ -5899,13 +5893,12 @@ package body Exp_Util is
return OK;
end Search_Primitive_Calls;
- procedure Search_Calls is new Traverse_Proc (Search_Primitive_Calls);
+ function Search_Calls is new Traverse_Func (Search_Primitive_Calls);
-- Start of processing for Expression_Contains_Primitives_Calls_Of_Type
begin
- Search_Calls (Expr);
- return Calls_OK;
+ return Search_Calls (Expr) = Abandon;
end Expression_Contains_Primitives_Calls_Of;
----------------------
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 89bd34d3c6f..b45be174798 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -13637,8 +13637,6 @@ package body Sem_Prag is
-------------------------
function Contains_Loop_Entry (Expr : Node_Id) return Boolean is
- Has_Loop_Entry : Boolean := False;
-
function Process (N : Node_Id) return Traverse_Result;
-- Process function for traversal to look for Loop_Entry
@@ -13651,20 +13649,18 @@ package body Sem_Prag is
if Nkind (N) = N_Attribute_Reference
and then Attribute_Name (N) = Name_Loop_Entry
then
- Has_Loop_Entry := True;
return Abandon;
else
return OK;
end if;
end Process;
- procedure Traverse is new Traverse_Proc (Process);
+ function Traverse is new Traverse_Func (Process);
-- Start of processing for Contains_Loop_Entry
begin
- Traverse (Expr);
- return Has_Loop_Entry;
+ return Traverse (Expr) = Abandon;
end Contains_Loop_Entry;
-- Local variables
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 4ef0fa3c3ef..4a26d962303 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -4324,11 +4324,9 @@ package body Sem_Util is
-------------------------
function Mentions_Post_State (N : Node_Id) return Boolean is
- Post_State_Seen : Boolean := False;
-
function Is_Post_State (N : Node_Id) return Traverse_Result;
- -- Attempt to find a construct that denotes a post-state. If this
- -- is the case, set flag Post_State_Seen.
+ -- If called with a construct that denotes a post-state, then
+ -- abandon the search.
-------------------
-- Is_Post_State --
@@ -4339,7 +4337,6 @@ package body Sem_Util is
begin
if Nkind (N) in N_Explicit_Dereference | N_Function_Call then
- Post_State_Seen := True;
return Abandon;
elsif Nkind (N) in N_Expanded_Name | N_Identifier then
@@ -4363,7 +4360,6 @@ package body Sem_Util is
and then Nkind (Parent (N)) =
N_Selected_Component)
then
- Post_State_Seen := True;
return Abandon;
end if;
@@ -4372,7 +4368,6 @@ package body Sem_Util is
return Skip;
elsif Attribute_Name (N) = Name_Result then
- Post_State_Seen := True;
return Abandon;
end if;
end if;
@@ -4380,14 +4375,12 @@ package body Sem_Util is
return OK;
end Is_Post_State;
- procedure Find_Post_State is new Traverse_Proc (Is_Post_State);
+ function Find_Post_State is new Traverse_Func (Is_Post_State);
-- Start of processing for Mentions_Post_State
begin
- Find_Post_State (N);
-
- return Post_State_Seen;
+ return Find_Post_State (N) = Abandon;
end Mentions_Post_State;
-- Local variables
--
2.43.0
