This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.
Index Nav: | [Date Index] [Subject Index] [Author Index] [Thread Index] | |
---|---|---|
Message Nav: | [Date Prev] [Date Next] | [Thread Prev] [Thread Next] |
Other format: | [Raw text] |
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
Index Nav: | [Date Index] [Subject Index] [Author Index] [Thread Index] | |
---|---|---|
Message Nav: | [Date Prev] [Date Next] | [Thread Prev] [Thread Next] |