Patchwork [Ada] Remove false positive for infinite loop warning

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

Comments

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
   begin
      Ptr.all;
   end Wrapper;
end Wrapping;

with Wrapping;
procedure Test_Loop is
   Found : Boolean := False;
   procedure Set_True;
   procedure Set_True is
   begin
      Found := True;
   end Set_True;
begin
   loop
      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  <dewar@adacore.com>

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

Patch

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