From patchwork Thu Jun 17 13:39:56 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 56048 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 E96941007D2 for ; Thu, 17 Jun 2010 23:39:59 +1000 (EST) Received: (qmail 458 invoked by alias); 17 Jun 2010 13:39:54 -0000 Received: (qmail 431 invoked by uid 22791); 17 Jun 2010 13:39:49 -0000 X-SWARE-Spam-Status: No, hits=-1.8 required=5.0 tests=AWL, BAYES_00, 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 13:39:41 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id 950E1CB021D; Thu, 17 Jun 2010 15:39:46 +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 CXYoA2I-3azw; Thu, 17 Jun 2010 15:39:46 +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 82A8BCB01EA; Thu, 17 Jun 2010 15:39:46 +0200 (CEST) Received: by saumur.act-europe.fr (Postfix, from userid 525) id 8C087D9AB0; Thu, 17 Jun 2010 15:39:56 +0200 (CEST) Date: Thu, 17 Jun 2010 15:39:56 +0200 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Ed Schonberg Subject: [Ada] Build-in place calls with inherited operations of untagged types Message-ID: <20100617133956.GA14591@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 When a call invokes an inherited operation, the parent function is placed on the tree after expansion. If the call is for a build-in-place function, subsequent expansion builds an access type to designate the constructed object. The designated type of this access type is the type imposed by the context, rather than that of the function, which may be the parent operation. The following must compile quietly in Ada05: procedure Limited_Problem is package Isolated is type Limited_Type is limited record Value : Integer:= -12345; end record; function Create return Limited_Type; end Isolated; package body Isolated is function Create return Limited_Type is begin return (others => <>); end Create; end Isolated; type Limited_Type_2 is new Isolated.Limited_Type; X : Limited_Type_2 := Create; begin null; end Limited_Problem; Tested on x86_64-pc-linux-gnu, committed on trunk 2010-06-17 Ed Schonberg * exp_ch6.adb (Make_Build_In_Place_Call_In_Object_Declaration): The designated type of the generated pointer is the type of the original expression, not that of the function call itself, because the return type may be an untagged derived type and the function may be an inherited operation. Index: exp_ch6.adb =================================================================== --- exp_ch6.adb (revision 160914) +++ exp_ch6.adb (working copy) @@ -5095,7 +5095,7 @@ package body Exp_Ch6 is Rewrite (Allocator, New_Allocator); -- Create a new access object and initialize it to the result of the - -- new uninitialized allocator. Do not use Allocator as the + -- new uninitialized allocator. Note: we do not use Allocator as the -- Related_Node of Return_Obj_Access in call to Make_Temporary below -- as this would create a sort of infinite "recursion". @@ -5660,7 +5660,10 @@ package body Exp_Ch6 is Add_Access_Actual_To_Build_In_Place_Call (Func_Call, Function_Id, Caller_Object, Is_Access => Pass_Caller_Acc); - -- Create an access type designating the function's result subtype + -- Create an access type designating the function's result subtype. We + -- use the type of the original expression because it may be a call to + -- an inherited operation, which the expansion has replaced with the + -- parent operation that yields the parent type. Ref_Type := Make_Temporary (Loc, 'A'); @@ -5671,7 +5674,7 @@ package body Exp_Ch6 is Make_Access_To_Object_Definition (Loc, All_Present => True, Subtype_Indication => - New_Reference_To (Result_Subt, Loc))); + New_Reference_To (Etype (Function_Call), Loc))); -- The access type and its accompanying object must be inserted after -- the object declaration in the constrained case, so that the function