[Ada] fixes in handling of aggregates

[Arnaud Charlet <charlet at adacore dot com>]

Tested on i686-linux, committed on trunk

Add missing initialization of secondary tags in extension aggregates.
After this patch, gnat.dg/aggr3.adb compiles and executes without errors.

Also, in order to minimize elaboration code, we recognize composite types whose
default values can be represented by a static aggregate. When an object of the
type is declared without an explicit initialization, we use this constructed
aggregate as a default expression, instead of a call to the initialization
procedure for the type.

In call to Init_Controller, pass False to Init_Pr, instead of
Ancestor_Is_Expression. Otherwise, for an extension aggregate like "(X with
Y)", Init_Controller will overwrite the record controller for the parent part,
thus losing track of X, so the parent part will not be finalized.
The following test should print:
Main
Hello from Adjust (Controlled_1)
Hello from Adjust (Controlled_2)
block
Proc_1
block done
Hello from Finalize (Controlled_2)
Hello from Finalize (Controlled_1)
Main done

procedure Extension_Agg_Test.Main is
   X : Parent;
   Y : Controlled_2;
begin
   Put_Line ("Main");
   Verbose := True;
   declare
      Derived_Object : Derived := (X with Y);
   begin
      Put_Line ("block");
      Proc_1 (Derived_Object);
      Put_Line ("block done");
   end;
   Verbose := False;
   Put_Line ("Main done");
end Extension_Agg_Test.Main;
package body Extension_Agg_Test is

   procedure Proc_1 (X : Parent'Class) is
   begin
      if Verbose then
         Put_Line ("Proc_1");
      end if;
   end Proc_1;

   procedure Initialize (X : in out Controlled_1) is
   begin
      if Verbose then
         Put_Line ("Hello from Initialize (Controlled_1)");
      end if;
   end Initialize;

   procedure Adjust (X : in out Controlled_1) is
   begin
      if Verbose then
         Put_Line ("Hello from Adjust (Controlled_1)");
      end if;
   end Adjust;

   procedure Finalize (X : in out Controlled_1) is
   begin
      if Verbose then
         Put_Line ("Hello from Finalize (Controlled_1)");
      end if;
   end Finalize;

   procedure Initialize (X : in out Controlled_2) is
   begin
      if Verbose then
         Put_Line ("Hello from Initialize (Controlled_2)");
      end if;
   end Initialize;

   procedure Adjust (X : in out Controlled_2) is
   begin
      if Verbose then
         Put_Line ("Hello from Adjust (Controlled_2)");
      end if;
   end Adjust;

   procedure Finalize (X : in out Controlled_2) is
   begin
      if Verbose then
         Put_Line ("Hello from Finalize (Controlled_2)");
      end if;
   end Finalize;

end Extension_Agg_Test;
with Ada.Finalization; use Ada.Finalization;
with GNAT.IO; use GNAT.IO;
package Extension_Agg_Test is

   type Controlled_1 is new Controlled with null record;
   procedure Initialize (X : in out Controlled_1);
   procedure Adjust (X : in out Controlled_1);
   procedure Finalize (X : in out Controlled_1);

   type Controlled_2 is new Controlled with null record;
   procedure Initialize (X : in out Controlled_2);
   procedure Adjust (X : in out Controlled_2);
   procedure Finalize (X : in out Controlled_2);

   type Parent is tagged
      record
         Comp1 : Controlled_1;
      end record;
   procedure Proc_1 (X : Parent'Class);

   type Derived is new Parent with
      record
         Comp2 : Controlled_2;
      end record;

   Verbose : Boolean := False;

end Extension_Agg_Test;

The explicit initialization of a record by means of an aggregate is
incomplete in case of tagged types covering abstract interfaces. After
this patch, gnat.dg/test_ifaces.adb compiles and executes without errors.

Finally, in processing record aggregates, one case was missed for testing
cases that the back end cannot handle, namely the case where one of the
aggregate values is a possibly bit aligned component, causing a back end
blow up trying to process the resulting aggregate. An appropriat test has
been added to expand the aggregate to assignments in this case. A similar
change is made for array aggregates (though it is not clear that this is
absolutely necessary, since in practice it seems like this is taken care
of by other checks, but it is certainly more secure to add the check.

gnat.dg/aggr4.adb should compile cleanly.

2007-06-06  Javier Miranda  <miranda@adacore.com>
	    Ed Schonberg  <schonberg@adacore.com>
	    Bob Duff  <duff@adacore.com>
	    Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_aggr.ads, exp_aggr.adb
	(Build_Record_Aggr_Code): Add missing initialization of secondary tags
	in extension aggregates.
	(Flatten): Other conditions being met, an aggregate is static if the
	low bound given by component associations is different from the low
	bound of the base index type.
	(Packed_Array_Aggregate_Handled): If the component type is itself a
	packed array or record, the front-end must expand into assignments.
	(Gen_Ctrl_Actions_For_Aggr): In call to Init_Controller, pass False to
	Init_Pr, instead of Ancestor_Is_Expression.
	(Gen_Ctrl_Actions_For_Aggr): When processing an aggregate of a
	coextension chain root, either generate a list controller or use the
	already existing one.
	(Static_Array_Aggregate): New procedure to construct a positional
	aggregate that can be handled by the backend, when all bounds and
	components are compile-time known constants.
	(Expand_Record_Aggregate): Force conversion of aggregates of tagged
	types covering interface types into assignments.
	(Replace_Type): move to Build_Record_Aggr_Code.
	(Expand_Record_Aggr_Code): if the target of the aggregate is an
	interface type, convert to the definite type of the aggregate itself,
	so that needed components are visible.
	(Convert_Aggr_In_Object_Decl): If the aggregate has controlled
	components and the context is an extended return statement do not
	create a transient block for it, to prevent premature finalization
	before the return is executed.
	(Gen_Assign): Do not generate a call to deep adjust routine if the
	component type is itself an array of controlled (sub)-components
	initialized with an inner aggregate.
	(Component_Check): New name for Static_Check. This name is now more
	appropriate, and documentation is added which was missing.
	(Component_Check): Add test for bit aligned component value
	(Component_Not_OK_For_Backend): Renames Has_Delayed_Nested_Aggregate_Or_
	Tagged_Comps, name is more appropriate given added function below.
	(Component_Not_OK_For_Backend): Check for bit aligned component ref.

Attachment: difs
Description: Text document