[Ada] Program_Unit pragmas in generic units are inherited by instances

[Ada] Program_Unit pragmas in generic units are inherited by instances

[Arnaud Charlet]

[-- Attachment #1: Type: text/plain, Size: 2030 bytes --]

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  <schonberg@adacore.com>

	* sem_ch12.adb (Analyze_Subprogram_Instantiation): If the
	generic unit is not intrinsic and has an explicit convention,
	the instance inherits it.


[-- Attachment #2: difs --]
[-- Type: text/plain, Size: 1578 bytes --]

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