[Ada] Fix bugs in aggregate handling

[Arnaud Charlet <charlet at adacore dot com>]

Tested on i686-linux, committed on trunk

The back-end can build complex aggregates statically if all the components
and the bounds are static constants. However the back-end cannot handle
static aggregates for discriminated records with variants, and therefore
the front-end must expand array aggregates with such components into the
usual sequence of assignments and loops.

gnat.dg/aggr1.adb now compiles and executes quietly.

Also, the relative order of initialization of the record controller and the
controlled components, if any, must be the same whether the components
have an explicit initialization or a default one.
The execution of program p3 must produce the following output:
--
Building # 1
Building # 2
before aggregate
Building # 3
Building # 4
Finalizing # 2
Finalizing # 1
Adjusting # 3 =>  30
Adjusting # 4 =>  40
Finalizing # 4
Finalizing # 3
after aggregate
Finalizing # 40
Finalizing # 30
--
with ada.Finalization; use Ada.Finalization;
package pack is
  type Some_Controlled_Type is new Controlled with record
     Serial_Number : Integer;
  end record;
--
  type pair is record
    first, second: Some_controlled_Type;
  end record;
--
  procedure Initialize (It : in out Some_Controlled_Type);
  procedure Finalize   (It : in out Some_Controlled_Type);
  procedure Adjust     (It : in out Some_Controlled_Type);
end Pack;
--
with Text_IO; use Text_IO;
package body pack is
  Counter : integer := 0;
  function Next return Integer is
  begin
     Counter := Counter + 1;
     return COunter;
  end;
--
  procedure Initialize (It : in out Some_Controlled_Type) is
  begin
     It.Serial_Number := Next;
     Put_Line ("Building #" & integer'image (It.Serial_Number));
  end;
--
  procedure Finalize (It : in out Some_Controlled_Type) is
  begin
     Put_Line ("Finalizing #" & integer'image (It.Serial_Number));
  end;
--
  procedure Adjust (It : in out Some_Controlled_Type) is
     prev : constant integer := It.Serial_Number;
     next : constant integer := prev * 10;
  begin
     Put_Line ("Adjusting #" & integer'image (prev) &
       " => " &  integer'image (next));
     It.Serial_Number := next;
  end;
end Pack;
--
with Pack; use Pack;
with Text_IO; use text_IO;
with Ada.Finalization; use Ada.Finalization;
procedure P3 is
   P : Pair;   --  1, 2 initialized
begin
   Put_Line ("before aggregate");
   P := (others => <>);         --  4, 5, initialized. 1, 2 finalized.
   Put_Line ("after aggregate");
   --  Finalize everyone
end P3;

Finally, this code activates a special circuit to slide array aggregates that
appear as component expressions in record aggregates. Previously, there was an
incorrect guard on this circuit that incorrectly prevented it from being
activated in some cases where it was actually required. This change removes
the bogus guard.

The code below, when built with 'gnatmake -z toto', must produce the
following output:
P.S'First = 1
P.S (P.S'First) = 65
Q.S'First = 1
Q.S (Q.S'First) = 66
R.S'First = 1
R.S (R.S'First) = 67
S.S'First = 1
S.S (S.S'First) = 68
T.S'First = 1
T.S (T.S'First) = 69

--  Source code follows
package Toto is
   pragma Elaborate_Body;
   type Rec (L : Positive) is record
      S : String (L .. L) := (others => 'A');
   end record;
   type A_Rec is access all Rec;
   P : Rec (1);
   Q : constant A_Rec := new Rec'(L => 1, S => (2 .. 2 => 'B'));
   R : constant Rec := Rec'(L => 1, S => (2 .. 2 => 'C'));
   S : Rec := Rec'(L => 1, S => (2 .. 2 => 'D'));
   T : Rec := (L => 1, S => (2 .. 2 => 'E'));
end Toto;

with Ada.Text_IO; use Ada.Text_IO;
package body Toto is
begin
   Put_Line ("P.S'First =" & P.S'First'Img);
   Put_Line ("P.S (P.S'First) =" & Character'Pos (P.S (P.S'First))'Img);
   Put_Line ("Q.S'First =" & Q.S'First'Img);
   Put_Line ("Q.S (Q.S'First) =" & Character'Pos (Q.S (Q.S'First))'Img);
   Put_Line ("R.S'First =" & R.S'First'Img);
   Put_Line ("R.S (R.S'First) =" & Character'Pos (R.S (R.S'First))'Img);
   Put_Line ("S.S'First =" & S.S'First'Img);
   Put_Line ("S.S (S.S'First) =" & Character'Pos (S.S (S.S'First))'Img);
   Put_Line ("T.S'First =" & T.S'First'Img);
   Put_Line ("T.S (T.S'First) =" & Character'Pos (T.S (T.S'First))'Img);
end Toto;

2007-04-06  Ed Schonberg  <schonberg@adacore.com>
	    Thomas Quinot  <quinot@adacore.com>

	* exp_aggr.adb:
	If the array component is a discriminated record, the array aggregate
	is non-static even if the component is given by an aggregate with
	static components.
	(Expand_Record_Aggregate): Use First/Next_Component_Or_Discriminant
	(Convert_Aggr_In_Allocator): If the allocator is for an access
	discriminant and the type is controlled. do not place on a finalization
	list at this point. The proper list will be determined from the
	enclosing object.
	(Build_Record_Aggr_Code): If aggregate has box-initialized components,
	initialize record controller if needed, before the components, to ensure
	that they are properly finalized.
	(Build_Record_Aggr_Code): For the case of an array component that has a
	corresponding array aggregate in the record aggregate, perform sliding
	if required.

Attachment: difs
Description: Text document