[Ada] Remove more cases of empty loops

2020-06-03  Arnaud Charlet  <charlet@adacore.com>

gcc/ada/

	* sem_util.ads, sem_util.adb (Side_Effect_Free_Statements,
	Side_Effect_Free_Loop): New functions.
	(Has_Non_Null_Statements): Consider N_Call_Marker as a null
	statement.
	* sem_ch5.adb (Analyze_Loop_Parameter_Specification): Call
	Set_Is_Null_Loop even inside a generic instantiation.
	(Analyze_Loop_Statement): Mark for removal loops with no side
	effects.

3 files changed, 113 insertions, 16 deletions

diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
index b7bcb85..72e3a521 100644
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -3210,8 +3210,9 @@ package body Sem_Ch5 is
         and then Is_Discrete_Type (Etype (DS))
       then
          declare
-            L : Node_Id;
-            H : Node_Id;
+            L          : Node_Id;
+            H          : Node_Id;
+            Null_Range : Boolean := False;
 
          begin
             if Nkind (DS) = N_Range then
@@ -3231,6 +3232,14 @@ package body Sem_Ch5 is
             --  null range may be detected statically.
 
             if Compile_Time_Compare (L, H, Assume_Valid => True) = GT then
+               if Compile_Time_Compare (L, H, Assume_Valid => False) = GT then
+                  --  Since we know the range of the loop is always null,
+                  --  set the appropriate flag to remove the loop entirely
+                  --  during expansion.
+
+                  Set_Is_Null_Loop (Loop_Nod);
+                  Null_Range := True;
+               end if;
 
                --  Suppress the warning if inside a generic template or
                --  instance, since in practice they tend to be dubious in these
@@ -3241,24 +3250,14 @@ package body Sem_Ch5 is
                   --  Specialize msg if invalid values could make the loop
                   --  non-null after all.
 
-                  if Compile_Time_Compare
-                       (L, H, Assume_Valid => False) = GT
-                  then
-                     --  Since we know the range of the loop is null, set the
-                     --  appropriate flag to remove the loop entirely during
-                     --  expansion.
-
-                     Set_Is_Null_Loop (Loop_Nod);
-
+                  if Null_Range then
                      if Comes_From_Source (N) then
                         Error_Msg_N
                           ("??loop range is null, loop will not execute", DS);
                      end if;
 
-                     --  Here is where the loop could execute because of
-                     --  invalid values, so issue appropriate message and in
-                     --  this case we do not set the Is_Null_Loop flag since
-                     --  the loop may execute.
+                  --  Here is where the loop could execute because of
+                  --  invalid values, so issue appropriate message.
 
                   elsif Comes_From_Source (N) then
                      Error_Msg_N
@@ -3994,6 +3993,12 @@ package body Sem_Ch5 is
          Analyze_Statements (Statements (N));
       end if;
 
+      --  If the loop has no side effects, mark it for removal.
+
+      if Side_Effect_Free_Loop (N) then
+         Set_Is_Null_Loop (N);
+      end if;
+
       --  When the iteration scheme of a loop contains attribute 'Loop_Entry,
       --  the loop is transformed into a conditional block. Retrieve the loop.
 
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 09fcfb7..dff9f81 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -11536,7 +11536,7 @@ package body Sem_Util is
          Node := First (L);
 
          loop
-            if Nkind (Node) /= N_Null_Statement then
+            if not Nkind_In (Node, N_Null_Statement, N_Call_Marker) then
                return True;
             end if;
 
@@ -11548,6 +11548,91 @@ package body Sem_Util is
       return False;
    end Has_Non_Null_Statements;
 
+   ---------------------------------
+   -- Side_Effect_Free_Statements --
+   ---------------------------------
+
+   function Side_Effect_Free_Statements (L : List_Id) return Boolean is
+      Node : Node_Id;
+
+   begin
+      if Is_Non_Empty_List (L) then
+         Node := First (L);
+
+         loop
+            case Nkind (Node) is
+               when N_Null_Statement | N_Call_Marker | N_Raise_xxx_Error =>
+                  null;
+               when N_Object_Declaration =>
+                  if Present (Expression (Node))
+                    and then not Side_Effect_Free (Expression (Node))
+                  then
+                     return False;
+                  end if;
+
+               when others =>
+                  return False;
+            end case;
+
+            Next (Node);
+            exit when Node = Empty;
+         end loop;
+      end if;
+
+      return True;
+   end Side_Effect_Free_Statements;
+
+   ---------------------------
+   -- Side_Effect_Free_Loop --
+   ---------------------------
+
+   function Side_Effect_Free_Loop (N : Node_Id) return Boolean is
+      Scheme : Node_Id;
+      Spec   : Node_Id;
+      Subt   : Node_Id;
+
+   begin
+      --  If this is not a loop (e.g. because the loop has been rewritten),
+      --  then return false.
+
+      if Nkind (N) /= N_Loop_Statement then
+         return False;
+      end if;
+
+      --  First check the statements
+
+      if Side_Effect_Free_Statements (Statements (N)) then
+
+         --  Then check the loop condition/indexes
+
+         if Present (Iteration_Scheme (N)) then
+            Scheme := Iteration_Scheme (N);
+
+            if Present (Condition (Scheme))
+              or else Present (Iterator_Specification (Scheme))
+            then
+               return False;
+            elsif Present (Loop_Parameter_Specification (Scheme)) then
+               Spec := Loop_Parameter_Specification (Scheme);
+               Subt := Discrete_Subtype_Definition (Spec);
+
+               if Present (Subt) then
+                  if Nkind (Subt) = N_Range then
+                     return Side_Effect_Free (Low_Bound (Subt))
+                       and then Side_Effect_Free (High_Bound (Subt));
+                  else
+                     --  subtype indication
+
+                     return True;
+                  end if;
+               end if;
+            end if;
+         end if;
+      end if;
+
+      return False;
+   end Side_Effect_Free_Loop;
+
    ----------------------------------
    -- Has_Non_Trivial_Precondition --
    ----------------------------------
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index e6aa9e2..13bbc6a 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -1309,6 +1309,13 @@ package Sem_Util is
    function Has_Non_Null_Statements (L : List_Id) return Boolean;
    --  Return True if L has non-null statements
 
+   function Side_Effect_Free_Statements (L : List_Id) return Boolean;
+   --  Return True if L has no statements with side effects
+
+   function Side_Effect_Free_Loop (N : Node_Id) return Boolean;
+   --  Return True if the loop has no side effect and can therefore be
+   --  marked for removal. Return False if N is not a N_Loop_Statement.
+
    function Has_Overriding_Initialize (T : Entity_Id) return Boolean;
    --  Predicate to determine whether a controlled type has a user-defined
    --  Initialize primitive (and, in Ada 2012, whether that primitive is