diff mbox

[Ada] Consistent Ada_Versions in instance bodies

Message ID 20100623095429.GA5148@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet June 23, 2010, 9:54 a.m. UTC
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.
diff mbox

Patch

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;