From patchwork Fri Sep 2 09:27:46 2011 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 113067 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 CA32DB6F71 for ; Fri, 2 Sep 2011 19:28:07 +1000 (EST) Received: (qmail 1465 invoked by alias); 2 Sep 2011 09:28:04 -0000 Received: (qmail 1457 invoked by uid 22791); 2 Sep 2011 09:28:04 -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; Fri, 02 Sep 2011 09:27:47 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 030642BB477; Fri, 2 Sep 2011 05:27:47 -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 YzTCmTV0GOg3; Fri, 2 Sep 2011 05:27:46 -0400 (EDT) Received: from kwai.gnat.com (kwai.gnat.com [205.232.38.4]) by rock.gnat.com (Postfix) with ESMTP id D41FE2BB476; Fri, 2 Sep 2011 05:27:46 -0400 (EDT) Received: by kwai.gnat.com (Postfix, from userid 4192) id D32103FEE8; Fri, 2 Sep 2011 05:27:46 -0400 (EDT) Date: Fri, 2 Sep 2011 05:27:46 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Ed Schonberg Subject: [Ada] Program_Unit pragmas in generic units are inherited by instances Message-ID: <20110902092746.GA27958@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 Pragmas on generic units, if they are not library unit pragmas, are inherited by each instantiation of the generic. Pragma Convention was omitted from this processing. The following must execute quietly: gnatmake -q address_test.adb address_test --- with Ada.Text_Io; use Ada.Text_IO; with Interfaces; with System.Address_Image; use System; procedure Address_Test is Addr_1 : System.Address; Addr_2 : System.Address; generic type Item_Type is limited private; function Test_Address (Item : in Item_Type) return Interfaces.Unsigned_64; pragma Convention (C, Test_Address); function Test_Address (Item : in Item_Type) return Interfaces.Unsigned_64 is begin Addr_2 := Item'Address; return 1; end; type Object_Type is record Data_01 : Interfaces.Unsigned_64 := 01; Data_02 : Interfaces.Unsigned_64 := 02; end record; type Object_Type_2 is record Data_01 : Interfaces.Unsigned_64 := 01; Data_02 : Interfaces.Unsigned_64 := 02; Data_03 : Interfaces.Unsigned_64 := 03; end record; function Test_Object_Address is new Test_Address (Item_Type => Object_Type); Test_Object : Object_Type; function Test_Object_2_Address is new Test_Address (Item_Type => Object_Type_2); Test_Object_2 : Object_Type_2; U64 : Interfaces.Unsigned_64 := 666; begin Addr_1 := Test_Object'Address; U64 := Test_Object_Address (Item => Test_Object); if Addr_1 /= Addr_2 then Put_Line ("Test_Object: different addresses"); end if; Addr_1 := Test_Object_2'Address; U64 := Test_Object_2_Address (Item => Test_Object_2); if Addr_1 /= Addr_2 then Put_Line ("Test_Object_2: different addresses"); end if; end Address_Test; Tested on x86_64-pc-linux-gnu, committed on trunk 2011-09-02 Ed Schonberg * sem_ch12.adb (Analyze_Subprogram_Instantiation): If the generic unit is not intrinsic and has an explicit convention, the instance inherits it. Index: sem_ch12.adb =================================================================== --- sem_ch12.adb (revision 178398) +++ sem_ch12.adb (working copy) @@ -4430,8 +4430,6 @@ -- for the compilation, we generate the instance body even if it is -- not within the main unit. - -- Any other pragmas might also be inherited ??? - if Is_Intrinsic_Subprogram (Gen_Unit) then Set_Is_Intrinsic_Subprogram (Anon_Id); Set_Is_Intrinsic_Subprogram (Act_Decl_Id); @@ -4441,6 +4439,17 @@ end if; end if; + -- Inherit convention from generic unit. Intrinsic convention, as for + -- an instance of unchecked conversion, is not inherited because an + -- explicit Ada instance has been created. + + if Has_Convention_Pragma (Gen_Unit) + and then Convention (Gen_Unit) /= Convention_Intrinsic + then + Set_Convention (Act_Decl_Id, Convention (Gen_Unit)); + Set_Is_Exported (Act_Decl_Id, Is_Exported (Gen_Unit)); + end if; + Generate_Definition (Act_Decl_Id); Set_Contract (Anon_Id, Make_Contract (Sloc (Anon_Id))); -- ??? needed? Set_Contract (Act_Decl_Id, Make_Contract (Sloc (Act_Decl_Id))); @@ -4479,8 +4488,6 @@ Check_Hidden_Child_Unit (N, Gen_Unit, Act_Decl_Id); - -- Subject to change, pending on if other pragmas are inherited ??? - Validate_Categorization_Dependency (N, Act_Decl_Id); if not Is_Intrinsic_Subprogram (Act_Decl_Id) then