ada: Simplify traversal procedures into traversal functions

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.

diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index afcb0a9d328fed1bc710e61b95e41ba8a6e1660b..71bca1cdc886c8e40ea1091c45ef8b5bc010fff3 100644 (file)
--- 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 e449d45cdfdbeda9f2f80b7083742fca8a202526..b9a9b5ff953336732d271f8c7bace7e0c6e45e45 100644 (file)
--- 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 89bd34d3c6f47e8b66b9c728156af69bbc6ea953..b45be1747981b7142a9667609bb0ad7afa4b2b0f 100644 (file)
--- 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 4ef0fa3c3efc31fbaba18751c808faa2be17d6f4..4a26d96230339ac4f1630e5a943e03df29abfafe 100644 (file)
--- 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