From patchwork Tue Oct 5 09:57:24 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 66781 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 C0788B6EDF for ; Tue, 5 Oct 2010 20:57:43 +1100 (EST) Received: (qmail 15335 invoked by alias); 5 Oct 2010 09:57:33 -0000 Received: (qmail 15268 invoked by uid 22791); 5 Oct 2010 09:57:31 -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; Tue, 05 Oct 2010 09:57:27 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id 2669DCB0236; Tue, 5 Oct 2010 11:57:25 +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 zP8aburB6w9c; Tue, 5 Oct 2010 11:57:25 +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 147D6CB01DF; Tue, 5 Oct 2010 11:57:25 +0200 (CEST) Received: by saumur.act-europe.fr (Postfix, from userid 525) id E3F00D9BB5; Tue, 5 Oct 2010 11:57:24 +0200 (CEST) Date: Tue, 5 Oct 2010 11:57:24 +0200 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Thomas Quinot Subject: [Ada] DSA helpers for tagged types Message-ID: <20101005095724.GA6194@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 using PolyORB/DSA, helper subprograms are generated for each data type used as a formal parameter type in a remotely callable subprogram. For tagged types, these subprograms are primitive operations of the type, but only if they are generated in the proper scope, before the type is frozen. Otherwise the general rule of generating them with a unique name must be followed, to avoid generating duplicate bodies with the same signature. No test (requires full PolyORB setup). Tested on x86_64-pc-linux-gnu, committed on trunk 2010-10-05 Thomas Quinot * exp_dist.adb (Make_Helper_Function_Name): For a tagged type, use canonical name without serial number only if the helper is becoming a primitive of the type. Index: exp_dist.adb =================================================================== --- exp_dist.adb (revision 164906) +++ exp_dist.adb (working copy) @@ -10549,9 +10549,9 @@ package body Exp_Dist is if Is_Itype (Typ) and then Typ /= Base_Type (Typ) then Build_TypeCode_Function (Loc => Loc, - Typ => Etype (Typ), - Decl => Decl, - Fnam => Fnam); + Typ => Etype (Typ), + Decl => Decl, + Fnam => Fnam); return; end if; @@ -11036,26 +11036,30 @@ package body Exp_Dist is begin declare Serial : Nat := 0; - -- For tagged types, we use a canonical name so that it matches - -- the primitive spec. For all other cases, we use a serialized - -- name so that multiple generations of the same procedure do - -- not clash. + -- For tagged types that aren't frozen yet, generate the helper + -- under its canonical name so that it matches the primitive + -- spec. For all other cases, we use a serialized name so that + -- multiple generations of the same procedure do not clash. begin - if not Is_Tagged_Type (Typ) then + if Is_Tagged_Type (Typ) and then not Is_Frozen (Typ) then + null; + + else Serial := Increment_Serial_Number; end if; - -- Use prefixed underscore to avoid potential clash with used + -- Use prefixed underscore to avoid potential clash with user -- identifier (we use attribute names for Nam). return Make_Defining_Identifier (Loc, Chars => New_External_Name - (Related_Id => Nam, - Suffix => ' ', Suffix_Index => Serial, - Prefix => '_')); + (Related_Id => Nam, + Suffix => ' ', + Suffix_Index => Serial, + Prefix => '_')); end; end Make_Helper_Function_Name; end Helpers;