From patchwork Thu Jun 17 08:43:37 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 55987 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id DE0161007D6 for ; Thu, 17 Jun 2010 18:43:34 +1000 (EST) Received: (qmail 30630 invoked by alias); 17 Jun 2010 08:43:30 -0000 Received: (qmail 30617 invoked by uid 22791); 17 Jun 2010 08:43:28 -0000 X-SWARE-Spam-Status: No, hits=-1.1 required=5.0 tests=AWL, BAYES_05, T_RP_MATCHES_RCVD X-Spam-Check-By: sourceware.org Received: from mel.act-europe.fr (HELO mel.act-europe.fr) (212.99.106.210) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Thu, 17 Jun 2010 08:43:23 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id 8FDEDCB026F; Thu, 17 Jun 2010 10:43:28 +0200 (CEST) Received: from mel.act-europe.fr ([127.0.0.1]) by localhost (smtp.eu.adacore.com [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id X9i4Tsg-z3x8; Thu, 17 Jun 2010 10:43:28 +0200 (CEST) Received: from saumur.act-europe.fr (saumur.act-europe.fr [10.10.0.183]) by mel.act-europe.fr (Postfix) with ESMTP id 7D7CFCB026D; Thu, 17 Jun 2010 10:43:28 +0200 (CEST) Received: by saumur.act-europe.fr (Postfix, from userid 525) id 52560D9AB0; Thu, 17 Jun 2010 10:43:37 +0200 (CEST) Date: Thu, 17 Jun 2010 10:43:37 +0200 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Robert Dewar Subject: [Ada] Remove false positive for infinite loop warning Message-ID: <20100617084337.GA22722@adacore.com> Mime-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.9i X-IsSubscribed: yes Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org 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 * sem_warn.adb (Test_Ref): Abandon scan if access subprogram parameter found. 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