Patchwork [Ada] Remove false positive for infinite loop warning

mail settings
Submitter Arnaud Charlet
Date June 17, 2010, 8:43 a.m.
Message ID <>
Download mbox | patch
Permalink /patch/55987/
State New
Headers show


Arnaud Charlet - June 17, 2010, 8:43 a.m.
This patch suppresses warning messages for infinite loops if the
loop has a call with an argument of access-to-subprogram type. This
avoids some false positives as illustrated by the following example:

package Wrapping is
   procedure Wrapper (Ptr : not null access procedure);
end Wrapping;

package body Wrapping is
   procedure Wrapper (Ptr : not null access procedure) is
   end Wrapper;
end Wrapping;

with Wrapping;
procedure Test_Loop is
   Found : Boolean := False;
   procedure Set_True;
   procedure Set_True is
      Found := True;
   end Set_True;
      Wrapping.Wrapper (Set_True'Access);
      exit when Found;
   end loop;
end Test_Loop;

This now compiles and executes quietly with -gnat05. Previously
there was an incorrect warning about a possible infinite loop
on the exit when.

Tested on x86_64-pc-linux-gnu, committed on trunk

2010-06-17  Robert Dewar  <>

	* sem_warn.adb (Test_Ref): Abandon scan if access subprogram parameter


Index: sem_warn.adb
--- sem_warn.adb	(revision 160849)
+++ sem_warn.adb	(working copy)
@@ -539,6 +539,22 @@  package body Sem_Warn is
                return Abandon;
             end if;
+            --  If any of the arguments are of type access to subprogram, then
+            --  we may have funny side effects, so no warning in this case.
+            declare
+               Actual : Node_Id;
+            begin
+               Actual := First_Actual (N);
+               while Present (Actual) loop
+                  if Is_Access_Subprogram_Type (Etype (Actual)) then
+                     return Abandon;
+                  else
+                     Next_Actual (Actual);
+                  end if;
+               end loop;
+            end;
          --  Declaration of the variable in question
          elsif Nkind (N) = N_Object_Declaration