From patchwork Tue Aug 2 10:06:26 2011 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 107876 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 B84C4B71BE for ; Tue, 2 Aug 2011 20:06:45 +1000 (EST) Received: (qmail 13837 invoked by alias); 2 Aug 2011 10:06:43 -0000 Received: (qmail 13829 invoked by uid 22791); 2 Aug 2011 10:06:42 -0000 X-SWARE-Spam-Status: No, hits=-1.3 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, 02 Aug 2011 10:06:27 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id CF0502BAB1A; Tue, 2 Aug 2011 06:06:26 -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 ykNdiMs-is1Q; Tue, 2 Aug 2011 06:06:26 -0400 (EDT) Received: from kwai.gnat.com (kwai.gnat.com [205.232.38.4]) by rock.gnat.com (Postfix) with ESMTP id BC6FA2BAAFC; Tue, 2 Aug 2011 06:06:26 -0400 (EDT) Received: by kwai.gnat.com (Postfix, from userid 4192) id BBE2392A55; Tue, 2 Aug 2011 06:06:26 -0400 (EDT) Date: Tue, 2 Aug 2011 06:06:26 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Ed Schonberg Subject: [Ada] Types derived from types with foreign conventions Message-ID: <20110802100626.GA27234@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 A private type may have its convention established by a pragma in the private part of its enclosing package. A subtype of this type has its convention fixed at the freeze point. A type derived from this subtype must get its convention from the base type, because it may be needed in the initialization call for an object of the derived type. The following must compile quietly: gcc -c -gnatws m_main.adb with SYSTEM; procedure M_MAIN is package q_mw_string is type Sequence is private; subtype Bounded_String is Sequence; private type Sequence is record r_array : string(1 .. 5) := (others => ascii.nul); end record; pragma Convention(C, Sequence); end q_mw_string; type T_OPERATOR_LEVEL is new Q_MW_STRING.Bounded_String; -- pragma Convention (C, T_Operator_Level); -- workaround V_BUFFER : STRING (1 .. 1000); CVN_V_LEVEL_ADDRESS : constant SYSTEM.ADDRESS := V_BUFFER'ADDRESS; VN_V_LEVEL : T_OPERATOR_LEVEL; -- VN_V_LEVEL : Q_MW_STRING.Bounded_String; -- workaround for VN_V_LEVEL'ADDRESS use CVN_V_LEVEL_ADDRESS; begin null; end M_MAIN; Tested on x86_64-pc-linux-gnu, committed on trunk 2011-08-02 Ed Schonberg * sem_ch3.adb (Build_Derived_Type): Inherit the convention from the base type, because the parent may be a subtype of a private type whose convention is established in a private part. Index: sem_ch3.adb =================================================================== --- sem_ch3.adb (revision 177119) +++ sem_ch3.adb (working copy) @@ -7836,10 +7836,15 @@ Set_Size_Info (Derived_Type, Parent_Type); Set_RM_Size (Derived_Type, RM_Size (Parent_Type)); - Set_Convention (Derived_Type, Convention (Parent_Type)); Set_Is_Controlled (Derived_Type, Is_Controlled (Parent_Type)); Set_Is_Tagged_Type (Derived_Type, Is_Tagged_Type (Parent_Type)); + -- If the parent type is a private subtype, the convention on the base + -- type may be set in the private part, and not propagated to the + -- subtype until later, so we obtain the convention from the base type. + + Set_Convention (Derived_Type, Convention (Parent_Base)); + -- Propagate invariant information. The new type has invariants if -- they are inherited from the parent type, and these invariants can -- be further inherited, so both flags are set. @@ -9918,9 +9923,10 @@ Set_Homonym (Full, Save_Homonym); Set_Associated_Node_For_Itype (Full, Related_Nod); - -- Set common attributes for all subtypes + -- Set common attributes for all subtypes: kind, convention, etc. Set_Ekind (Full, Subtype_Kind (Ekind (Full_Base))); + Set_Convention (Full, Convention (Full_Base)); -- The Etype of the full view is inconsistent. Gigi needs to see the -- structural full view, which is what the current scheme gives: