From e08a896b96792d73293db82d0dc3541c17e545ad Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Wed, 3 Jul 2019 08:15:28 +0000 Subject: [PATCH] [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 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 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/sem_warn.adb | 13 ++++++++++--- gcc/testsuite/ChangeLog | 5 +++++ gcc/testsuite/gnat.dg/warn20.adb | 11 +++++++++++ gcc/testsuite/gnat.dg/warn20_pkg.adb | 10 ++++++++++ gcc/testsuite/gnat.dg/warn20_pkg.ads | 8 ++++++++ 6 files changed, 49 insertions(+), 3 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/warn20.adb create mode 100644 gcc/testsuite/gnat.dg/warn20_pkg.adb create mode 100644 gcc/testsuite/gnat.dg/warn20_pkg.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index dd14590e9c1..02f35d5f233 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2019-07-03 Bob Duff + + * sem_warn.adb (Check_Infinite_Loop_Warning): Avoid the warning + if an Iterator_Specification is present. + 2019-07-03 Bob Duff * doc/gnat_ugn/gnat_utility_programs.rst: Document default diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index dda94d2d897..7e13aa51afe 100644 --- 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 de7b7ad89e8..c9f0bc6a0bb 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2019-07-03 Bob Duff + + * gnat.dg/warn20.adb, gnat.dg/warn20_pkg.adb, + gnat.dg/warn20_pkg.ads: New testcase. + 2019-07-03 Ed Schonberg * 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 index 00000000000..90fbf3200af --- /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 index 00000000000..7ee7ab735dd --- /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 index 00000000000..861484b9acb --- /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; -- 2.30.2