From patchwork Tue Aug 30 13:12:24 2011 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 112286 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 977A5B6F69 for ; Tue, 30 Aug 2011 23:12:49 +1000 (EST) Received: (qmail 18428 invoked by alias); 30 Aug 2011 13:12:44 -0000 Received: (qmail 18041 invoked by uid 22791); 30 Aug 2011 13:12:42 -0000 X-SWARE-Spam-Status: No, hits=-1.8 required=5.0 tests=AWL,BAYES_00 X-Spam-Check-By: sourceware.org Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Tue, 30 Aug 2011 13:12:25 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 2271A2BB1E3; Tue, 30 Aug 2011 09:12:25 -0400 (EDT) Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id BMk99FT97i1l; Tue, 30 Aug 2011 09:12:25 -0400 (EDT) Received: from kwai.gnat.com (kwai.gnat.com [205.232.38.4]) by rock.gnat.com (Postfix) with ESMTP id 0626A2BB1E1; Tue, 30 Aug 2011 09:12:25 -0400 (EDT) Received: by kwai.gnat.com (Postfix, from userid 4192) id F0D993FEE8; Tue, 30 Aug 2011 09:12:24 -0400 (EDT) Date: Tue, 30 Aug 2011 09:12:24 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Ed Schonberg Subject: [Ada] Prefixed calls as generic actuals Message-ID: <20110830131224.GA8822@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.20 (2009-06-14) 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 Generic actuals are pre-analyzed in order to capture external names, but are only fully analyzed within the instance. If an actual is a prefixed call to a dispatching operation, it may appear syntactically as a call without actuals. It is necessary to parse it as an object.operation again in order to capture the controlling first argument in the call. The following must compile quietly: gcc -c -gnat05 synch.adb --- package Synch is type Si is synchronized interface; function Name (P : Si) return String is abstract; procedure Need_Body; end Synch; --- package body Synch is procedure Need_Body is begin null; end Need_Body; type Access_T is not null access Si'Class; task type T is new Si with end T; overriding function Name (P : T) return String; function Name (P : T) return String is begin return "Hej hopp ditt feta nylle"; end Name; task body T is begin null; end T; TP : Access_T := Access_T'(new T); I : T; generic S : in String; package G is end; S1 : constant String := TP.Name; S2 : constant String := TP.all.Name; S3 : constant String := I.Name; package Works_Fine_1 is new G (S => S1); package Works_Fine_2 is new G (S => I.Name); package Trouble_1 is new G (S => TP.Name); package Trouble_2 is new G (S => TP.all.Name); end Synch; Tested on x86_64-pc-linux-gnu, committed on trunk 2011-08-30 Ed Schonberg * sem_res.adb (Check_Parameterless_Call): If the node is a selected component and the selector is a dispatching operation, check if it is a prefixed call before rewriting as a parameterless function call. Index: sem_res.adb =================================================================== --- sem_res.adb (revision 178293) +++ sem_res.adb (working copy) @@ -1115,6 +1115,20 @@ if Nkind (Parent (N)) /= N_Function_Call or else N /= Name (Parent (N)) then + + -- This may be a prefixed call that was not fully analyzed, e.g. + -- an actual in an instance. + + if Ada_Version >= Ada_2005 + and then Nkind (N) = N_Selected_Component + and then Is_Dispatching_Operation (Entity (Selector_Name (N))) + then + Analyze_Selected_Component (N); + if Nkind (N) /= N_Selected_Component then + return; + end if; + end if; + Nam := New_Copy (N); -- If overloaded, overload set belongs to new copy