From patchwork Wed Jun 23 09:54:29 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Subject: [Ada] Consistent Ada_Versions in instance bodies From: Arnaud Charlet X-Patchwork-Id: 56622 Message-Id: <20100623095429.GA5148@adacore.com> To: gcc-patches@gcc.gnu.org Cc: Ed Schonberg Date: Wed, 23 Jun 2010 11:54:29 +0200 The Ada_Version used to compile an instance may be established through a pragma in a configuration file, or through a pragma in the file containing the instance. In either case, the instance body, which is analyzed in a separate pass of the front-end, must be analyzed using the same version. This patch saves the Ada_Version in the pending instantiation information, so that it can be installed before a body is analyzed. The following must compile quietly: gcc -c -gnatws ex.adb pragma Ada_05; procedure Ex is generic type T_Item is private; Default_Item : access T_Item := null; PropertyName : String; function Get_Item (Connection : String) return T_Item; function Get_Item (Connection : String) return T_Item is Procedure_Name : constant String := "Get_Item(" & PropertyName & ")"; Obj : T_Item; begin if PropertyName = Connection then return Obj; elsif Default_Item = null then return Obj; else return Default_Item.all; end if; end Get_Item; function GetMessageId is new Get_Item ( T_Item => Integer, PropertyName => "HeaderMessageid"); begin null; end Ex; Tested on x86_64-pc-linux-gnu, committed on trunk 2010-06-23 Ed Schonberg * inline.ads: Include the current Ada_Version in the info for pending instance bodies, so that declaration and body are compiled with the same Ada_Version. * inline.adb: Move with_clause for Opt to spec. * sem_ch12.adb (Analyze_Package_Instantiation, Analyze_Subprogram_Instantiation): Save current Ada_Version in Pending_Instantiation information. (Instantiate_Package_Body, Instantiate_Subprogram_Body, Inline_Package_Body): Use the Ada_Version present in the body information. Index: inline.adb =================================================================== --- inline.adb (revision 161073) +++ inline.adb (working copy) @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -34,7 +34,6 @@ with Fname.UF; use Fname.UF; with Lib; use Lib; with Namet; use Namet; with Nlists; use Nlists; -with Opt; use Opt; with Sem_Aux; use Sem_Aux; with Sem_Ch8; use Sem_Ch8; with Sem_Ch10; use Sem_Ch10; Index: inline.ads =================================================================== --- inline.ads (revision 161073) +++ inline.ads (working copy) @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -36,6 +36,7 @@ -- Frontend, and thus are not mutually recursive. with Alloc; +with Opt; use Opt; with Sem; use Sem; with Table; with Types; use Types; @@ -84,6 +85,10 @@ package Inline is -- This means we have to capture this information from the current scope -- at the point of instantiation. + Version : Ada_Version_Type; + -- The body must be compiled with the same language version as the + -- spec. The version may be set by a configuration pragma in a separate + -- file or in the current file, and may differ from body to body. end record; package Pending_Instantiations is new Table.Table ( Index: sem_ch12.adb =================================================================== --- sem_ch12.adb (revision 161262) +++ sem_ch12.adb (working copy) @@ -3394,7 +3394,8 @@ package body Sem_Ch12 is Expander_Status => Expander_Active, Current_Sem_Unit => Current_Sem_Unit, Scope_Suppress => Scope_Suppress, - Local_Suppress_Stack_Top => Local_Suppress_Stack_Top)); + Local_Suppress_Stack_Top => Local_Suppress_Stack_Top, + Version => Ada_Version)); end if; end if; @@ -3701,7 +3702,8 @@ package body Sem_Ch12 is Expander_Status => Expander_Active, Current_Sem_Unit => Current_Sem_Unit, Scope_Suppress => Scope_Suppress, - Local_Suppress_Stack_Top => Local_Suppress_Stack_Top)), + Local_Suppress_Stack_Top => Local_Suppress_Stack_Top, + Version => Ada_Version)), Inlined_Body => True); Pop_Scope; @@ -3816,7 +3818,8 @@ package body Sem_Ch12 is Expander_Status => Expander_Active, Current_Sem_Unit => Current_Sem_Unit, Scope_Suppress => Scope_Suppress, - Local_Suppress_Stack_Top => Local_Suppress_Stack_Top)), + Local_Suppress_Stack_Top => Local_Suppress_Stack_Top, + Version => Ada_Version)), Inlined_Body => True); end if; end Inline_Instance_Body; @@ -3855,7 +3858,8 @@ package body Sem_Ch12 is Expander_Status => Expander_Active, Current_Sem_Unit => Current_Sem_Unit, Scope_Suppress => Scope_Suppress, - Local_Suppress_Stack_Top => Local_Suppress_Stack_Top)); + Local_Suppress_Stack_Top => Local_Suppress_Stack_Top, + Version => Ada_Version)); return True; else return False; @@ -8590,6 +8594,7 @@ package body Sem_Ch12 is Local_Suppress_Stack_Top := Body_Info.Local_Suppress_Stack_Top; Scope_Suppress := Body_Info.Scope_Suppress; + Opt.Ada_Version := Body_Info.Version; if No (Gen_Body_Id) then Load_Parent_Of_Generic @@ -8853,6 +8858,7 @@ package body Sem_Ch12 is Local_Suppress_Stack_Top := Body_Info.Local_Suppress_Stack_Top; Scope_Suppress := Body_Info.Scope_Suppress; + Opt.Ada_Version := Body_Info.Version; if No (Gen_Body_Id) then @@ -10801,7 +10807,8 @@ package body Sem_Ch12 is Get_Code_Unit (Sloc (Node (Decl))), Scope_Suppress => Scope_Suppress, Local_Suppress_Stack_Top => - Local_Suppress_Stack_Top); + Local_Suppress_Stack_Top, + Version => Ada_Version); -- Package instance @@ -10841,7 +10848,8 @@ package body Sem_Ch12 is Get_Code_Unit (Sloc (Inst_Node)), Scope_Suppress => Scope_Suppress, Local_Suppress_Stack_Top => - Local_Suppress_Stack_Top)), + Local_Suppress_Stack_Top, + Version => Ada_Version)), Body_Optional => Body_Optional); end; end if;