[Ada] Improve warnings about infinite loops

The compiler now has fewer false alarms when warning about infinite
loops. For example, a loop of the form "for X of A ...", where A is an
array, cannot be infinite.  The compiler no longer warns in this case.

2019-07-03  Bob Duff  <duff@adacore.com>

gcc/ada/

	* sem_warn.adb (Check_Infinite_Loop_Warning): Avoid the warning
	if an Iterator_Specification is present.

gcc/testsuite/

	* gnat.dg/warn20.adb, gnat.dg/warn20_pkg.adb,
	gnat.dg/warn20_pkg.ads: New testcase.

From-SVN: r272978

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index dd14590..02f35d5 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,10 @@
 2019-07-03  Bob Duff  <duff@adacore.com>
 
+       * sem_warn.adb (Check_Infinite_Loop_Warning): Avoid the warning
+       if an Iterator_Specification is present.
+
+2019-07-03  Bob Duff  <duff@adacore.com>
+
        * doc/gnat_ugn/gnat_utility_programs.rst: Document default
        new-line behavior.
 

diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
index dda94d2..7e13aa5 100644 (file)
--- a/gcc/ada/sem_warn.adb
+++ b/gcc/ada/sem_warn.adb
@@ -632,9 +632,16 @@ package body Sem_Warn is
 
                Expression := Condition (Iter);
 
-            --  For iteration, do not process, since loop will always terminate
-
-            elsif Present (Loop_Parameter_Specification (Iter)) then
+            --  For Loop_Parameter_Specification, do not process, since loop
+            --  will always terminate. For Iterator_Specification, also do not
+            --  process. Either it will always terminate (e.g. "for X of
+            --  Some_Array ..."), or we can't tell if it's going to terminate
+            --  without looking at the iterator, so any warning here would be
+            --  noise.
+
+            elsif Present (Loop_Parameter_Specification (Iter))
+              or else Present (Iterator_Specification (Iter))
+            then
                return;
             end if;
          end if;

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index de7b7ad..c9f0bc6 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2019-07-03  Bob Duff  <duff@adacore.com>
+
+       * gnat.dg/warn20.adb, gnat.dg/warn20_pkg.adb,
+       gnat.dg/warn20_pkg.ads: New testcase.
+
 2019-07-03  Ed Schonberg  <schonberg@adacore.com>
 
        * gnat.dg/predicate6.adb, gnat.dg/predicate6.ads: New testcase.

diff --git a/gcc/testsuite/gnat.dg/warn20.adb b/gcc/testsuite/gnat.dg/warn20.adb
new file mode 100644 (file)
index 0000000..90fbf32
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/warn20.adb
@@ -0,0 +1,11 @@
+--  { dg-do compile }
+--  { dg-options "-gnatwa" }
+
+with Warn20_Pkg;
+
+procedure Warn20 is
+   package P is new Warn20_Pkg (Integer, 0);
+   pragma Unreferenced (P);
+begin
+   null;
+end Warn20;

diff --git a/gcc/testsuite/gnat.dg/warn20_pkg.adb b/gcc/testsuite/gnat.dg/warn20_pkg.adb
new file mode 100644 (file)
index 0000000..7ee7ab7
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/warn20_pkg.adb
@@ -0,0 +1,10 @@
+package body Warn20_Pkg is
+   L : array (1 .. 10) of T := (1 .. 10 => None);
+   procedure Foo is
+   begin
+      for A of L loop
+         exit when A = None;
+         Dispatch (A);
+      end loop;
+   end;
+end;

diff --git a/gcc/testsuite/gnat.dg/warn20_pkg.ads b/gcc/testsuite/gnat.dg/warn20_pkg.ads
new file mode 100644 (file)
index 0000000..861484b
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/warn20_pkg.ads
@@ -0,0 +1,8 @@
+generic
+   type T is private;
+   None : T;
+package Warn20_Pkg is
+   generic
+      with procedure Dispatch (X : T) is null;
+   procedure Foo;
+end;