[Ada] Fixes to preelaborable initialization handling

[Arnaud Charlet <charlet at adacore dot com>]

This change updates the circuitry that handles the preelaborable initialization
property for controlled types. It fixes several bugs whereby some types
would erroneously be treated as not having preelaborable initialization.
It also implements one of the changes in AI05-028 for Ada 2012, to the
effect that a controlled type with an overriding Initialize primitive that
is a null subprogram does have preelaborable initialization.

The following compilations must produce the indicated results:

$ gcc -c -gnat05 q4_good_05.ads
<quiet acceptance>

$ gcc -c -gnat05 q4_bad_05.ads
q4_bad_05.ads:4:43: actual for "T" must have preelaborable initialization
q4_bad_05.ads:5:43: actual for "T" must have preelaborable initialization
q4_bad_05.ads:6:43: actual for "T" must have preelaborable initialization

$ gcc -c -gnat12 q4_good_12.ads
<quiet acceptance>

$ gcc -c -gnat12 q4_bad_12.ads
q4_bad_12.ads:4:43: actual for "T" must have preelaborable initialization
q4_bad_12.ads:5:43: actual for "T" must have preelaborable initialization

with Q4_Types;
with Q4_Gen;
package Q4_Bad_05 is
   package I1 is new Q4_Gen (T => Q4_Types.T1_No_Preelab);
   package I2 is new Q4_Gen (T => Q4_Types.T2_No_Preelab);
   package I3 is new Q4_Gen (T => Q4_Types.T1_Preelab12);
end Q4_Bad_05;
with Q4_Types;
with Q4_Gen;
package Q4_Bad_12 is
   package I1 is new Q4_Gen (T => Q4_Types.T1_No_Preelab);
   package I2 is new Q4_Gen (T => Q4_Types.T2_No_Preelab);
end Q4_Bad_12;
with Q4_Types;
with Q4_Gen;
package Q4_Bad_Inst is new Q4_Gen (T => Q4_Types.T99);
generic
   type T (<>) is private;
   pragma Preelaborable_Initialization (T);
package Q4_Gen is
end Q4_Gen;
with Q4_Types;
with Q4_Gen;
package Q4_Good_05 is
   package I1 is new Q4_Gen (T => Q4_Types.T1_Preelab05);
   package I2 is new Q4_Gen (T => Q4_Types.T2_Preelab05);
   package I3 is new Q4_Gen (T => Q4_Types.T3_Preelab05);
end Q4_Good_05;
with Q4_Types;
with Q4_Gen;
package Q4_Good_12 is
   package I1 is new Q4_Gen (T => Q4_Types.T1_Preelab12);
end Q4_Good_12;
package body Q4_Types is
   procedure Initialize (X : in out T2) is begin null; end Initialize;
end Q4_Types;
with Ada.Finalization;
package Q4_Types is

   --  The following types have preelaborable initialization in Ada 2005:

   type T1_Preelab05 is new Ada.Finalization.Controlled with null record;
   procedure Initialize (X : in out T1_Preelab05; Y : Integer);
   --  Non overriding Initialize procedure

   type T2_Preelab05 is new T1_Preelab05 with null record;
   procedure Initialize (X : in out T2_Preelab05; Y : Integer);
   --  Overriding Initialize procedure, but not for the predefined Initialize??

   type T3_Preelab05 is new Ada.Finalization.Controlled with null record;
   function Initialize (X : T3_Preelab05) return Integer;

   --  The following type has never preelaborable initialization

   type T1_No_Preelab is new Ada.Finalization.Controlled with null record;
   procedure Initialize (X : in out T1_No_Preelab);

   type T2_No_Preelab is new T1_No_Preelab with null record;
   procedure Initialize (X : in out T2_No_Preelab) is null;
   --  Null Initialize procedure, but ancestor type does not have preelab
   --  initialization anyway.

   --  The following type has preelaborable initialization in Ada 2012
   --  but not in Ada 2005:

   type T1_Preelab12 is new Ada.Finalization.Controlled with null record;
   procedure Initialize (X : in out T1_Preelab12) is null;


end Q4_Types;

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

2011-08-01  Thomas Quinot  <quinot@adacore.com>

	* sem_util.adb, sem_util.ads (Has_Overriding_Initialize): Make function
	conformant with its spec (return True only for types that have
	an overriding Initialize primitive operation that prevents them from
	having preelaborable initialization).
	* sem_cat.adb (Validate_Object_Declaration): Fix test for preelaborable
	initialization for controlled types in Ada 2005 or later mode.

Attachment: difs
Description: Text document