[Ada] Consistent Ada_Versions in instance bodies
Arnaud Charlet
charlet@adacore.com
Wed Jun 23 10:21:00 GMT 2010
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 <schonberg@adacore.com>
* 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.
-------------- next part --------------
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;
More information about the Gcc-patches
mailing list