[Ada] Default_Initial_Condition attributes apply to the base type

[Arnaud Charlet <charlet at adacore dot com>]

This patch modifies the implementation of pragma Default_Initial_Condition to
ensure that all internal attributes related to this annotation apply to the
base type.

------------
-- Source --
------------

--  gen_tester.ads

generic
   type Type_To_Test is private;
   Test_Id : Positive;

procedure Gen_Tester;

--  gen_tester.adb

with Ada.Assertions; use Ada.Assertions;
with Ada.Text_IO;    use Ada.Text_IO;

procedure Gen_Tester is
begin
   declare
      Val : Type_To_Test;
      pragma Unreferenced (Val);
   begin
      Put_Line ("ERROR" & Test_Id'Img & ": DIC check failed");
   end;
exception
   when Assertion_Error => Put_Line ("OK" & Test_Id'Img);
   when others => Put_Line ("ERROR" & Test_Id'Img & ": unexpected exception");
end Gen_Tester;

--  dic.ads

package DIC is
   type T1 is private
     with Default_Initial_Condition => To_Int (T1) = 1;

   type T2 is private
     with Default_Initial_Condition => To_Int (T2) = 10;

   subtype S1 is T1;
   subtype S2 is T2;

   function To_Int (Val : T1) return Integer;
   function To_Int (Val : T2) return Integer;

   procedure Test_DIC;

private
   type T1 is new Integer
     with Default_Value => 100;

   type T2 is new T1;

   subtype S3 is T1;
   subtype S4 is T2;
end DIC;

--  dic.adb

with Gen_Tester;

package body DIC is
   function To_Int (Val : T1) return Integer is
   begin
      return Integer (Val);
   end To_Int;

   function To_Int (Val : T2) return Integer is
   begin
      return Integer (Val);
   end To_Int;

   procedure Test_DIC is
      procedure Test_1 is new Gen_Tester (T1, 1);
      procedure Test_2 is new Gen_Tester (T2, 2);
      procedure Test_3 is new Gen_Tester (S1, 3);
      procedure Test_4 is new Gen_Tester (S2, 4);
      procedure Test_5 is new Gen_Tester (S3, 5);
      procedure Test_6 is new Gen_Tester (S4, 6);
   begin
      Test_1;
      Test_2;
      Test_3;
      Test_4;
      Test_5;
      Test_6;
   end Test_DIC;
end DIC;

--  main.adb

with DIC; use DIC;

procedure Main is
begin
   Test_DIC;
end Main;

----------------------------
-- Compilation and output --
----------------------------

$ gnatmake -q -gnata main.adb
$ ./main
OK 1
OK 2
OK 3
OK 4
OK 5
OK 6

Tested on x86_64-pc-linux-gnu, committed on trunk

2015-05-22  Hristian Kirtchev  <kirtchev@adacore.com>

	* einfo.adb (Default_Init_Cond_Procedure): Code cleanup. The
	attribute now applies to the base type.
	(Has_Default_Init_Cond): Now applies to the base type.
	(Has_Inherited_Default_Init_Cond): Now applies to the base type.
	(Set_Default_Init_Cond_Procedure): Code cleanup. The attribute now
	applies to the base type.
	(Set_Has_Default_Init_Cond): Now applies to the base type.
	(Set_Has_Inherited_Default_Init_Cond): Now applies to the base type.
	* exp_ch3.adb (Expand_N_Object_Declaration): No need to use the
	base type when adding a call to the Default_Initial_Condition.

Attachment: difs
Description: Text document