From patchwork Mon Nov 21 12:00:02 2011 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 126769 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 48B47B7205 for ; Mon, 21 Nov 2011 23:00:23 +1100 (EST) Received: (qmail 20937 invoked by alias); 21 Nov 2011 12:00:18 -0000 Received: (qmail 20849 invoked by uid 22791); 21 Nov 2011 12:00:17 -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; Mon, 21 Nov 2011 12:00:03 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 6B5AF2BB0F2; Mon, 21 Nov 2011 07:00:03 -0500 (EST) 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 gw9s9HhNhHZx; Mon, 21 Nov 2011 07:00:03 -0500 (EST) Received: from kwai.gnat.com (kwai.gnat.com [205.232.38.4]) by rock.gnat.com (Postfix) with ESMTP id 0ED952BB1B2; Mon, 21 Nov 2011 07:00:02 -0500 (EST) Received: by kwai.gnat.com (Postfix, from userid 4192) id 0EA4D3FEE8; Mon, 21 Nov 2011 07:00:02 -0500 (EST) Date: Mon, 21 Nov 2011 07:00:02 -0500 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Ed Schonberg Subject: [Ada] Access subprogram definitions as return types of access to subprograms Message-ID: <20111121120001.GA31201@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 Ada 2005 allows the declaration of an access to function whose return type is itself an access to function, etc. Each anonymous access type generated for this pathological construct has a scope which is the scope of the current declaration. The following must compile quietly in Ada 2005 mode, and output: It works It works It works --- with Text_IO; use Text_IO; function G return Integer is procedure Proc is begin Put_Line ("It works"); end Proc; function G0 return access procedure is begin return Proc'access; end; function G1 return access function return access procedure is begin return G0'access; end G1; function G2 return access function return access function return access procedure is begin return G1'access; end G2; begin G0.all; G1.all.all; G2.all.all.all; return 0; end; Tested on x86_64-pc-linux-gnu, committed on trunk 2011-11-21 Ed Schonberg * sem_ch3.adb (Access_Definition): If the access definition is itself the return type of an access to function definition which is ultimately the return type of an access to subprogram declaration, its scope is the enclosing scope of the ultimate access to subprogram. Index: sem_ch3.adb =================================================================== --- sem_ch3.adb (revision 181567) +++ sem_ch3.adb (working copy) @@ -726,13 +726,33 @@ -- If the access definition is the return type of another access to -- function, scope is the current one, because it is the one of the - -- current type declaration. + -- current type declaration, except for the pathological case below. if Nkind_In (Related_Nod, N_Object_Declaration, N_Access_Function_Definition) then Anon_Scope := Current_Scope; + -- A pathological case: function returning access functions that + -- return access functions, etc. Each anonymous access type created + -- is in the enclosing scope of the outermost function. + + declare + Par : Node_Id; + begin + Par := Related_Nod; + while Nkind_In (Par, + N_Access_Function_Definition, + N_Access_Definition) + loop + Par := Parent (Par); + end loop; + + if Nkind (Par) = N_Function_Specification then + Anon_Scope := Scope (Defining_Entity (Par)); + end if; + end; + -- For the anonymous function result case, retrieve the scope of the -- function specification's associated entity rather than using the -- current scope. The current scope will be the function itself if the