[Ada] Crash on partial initialization of controlled component

This patch modifies the late expansion of record aggregates to ensure that the
generated code which handles a controlled component initialized by a function
call is inserted in line with the rest of the initialization code, rather than
before the record aggregate. This way the function call has proper access to
the discriminants of the object being created.

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

gcc/ada/

	* exp_aggr.adb (Initialize_Ctrl_Record_Component): Insert the generated
	code for a transient component in line with the rest of the
	initialization code, rather than before the aggregate. This ensures
	that the component has proper visibility of the discriminants.

gcc/testsuite/

	* gnat.dg/controlled8.adb: New testcase.

From-SVN: r260532

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 3805c22..effa964 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,10 @@
+2018-05-22  Hristian Kirtchev  <kirtchev@adacore.com>
+
+       * exp_aggr.adb (Initialize_Ctrl_Record_Component): Insert the generated
+       code for a transient component in line with the rest of the
+       initialization code, rather than before the aggregate. This ensures
+       that the component has proper visibility of the discriminants.
+
 2018-05-22  Jerome Lambourg  <lambourg@adacore.com>
 
        * adaint.c: Reorganize QNX-specific macros, use syspage to retreive the

diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 975d32f..356686e 100644 (file)
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -2846,7 +2846,7 @@ package body Exp_Aggr is
 
          In_Place_Expansion :=
            Nkind (Init_Expr) = N_Function_Call
-                and then not Is_Build_In_Place_Result_Type (Comp_Typ);
+             and then not Is_Build_In_Place_Result_Type (Comp_Typ);
 
          --  The initialization expression is a controlled function call.
          --  Perform in-place removal of side effects to avoid creating a
@@ -2865,7 +2865,11 @@ package body Exp_Aggr is
             Set_No_Side_Effect_Removal (Init_Expr);
 
             --  Install all hook-related declarations and prepare the clean up
-            --  statements.
+            --  statements. The generated code follows the initialization order
+            --  of individual components and discriminants, rather than being
+            --  inserted prior to the aggregate. This ensures that a transient
+            --  component which mentions a discriminant has proper visibility
+            --  of the discriminant.
 
             Process_Transient_Component
               (Loc        => Loc,
@@ -2873,7 +2877,7 @@ package body Exp_Aggr is
                Init_Expr  => Init_Expr,
                Fin_Call   => Fin_Call,
                Hook_Clear => Hook_Clear,
-               Aggr       => N);
+               Stmts      => Stmts);
          end if;
 
          --  Use the noncontrolled component initialization circuitry to

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 8df5df8..c5c26fd 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2018-05-22  Hristian Kirtchev  <kirtchev@adacore.com>
+
+       * gnat.dg/controlled8.adb: New testcase.
+
 2018-05-22  Patrick Bernardi  <bernardi@adacore.com>
 
        * gnat.dg/discr50.adb: New testcase.

diff --git a/gcc/testsuite/gnat.dg/controlled8.adb b/gcc/testsuite/gnat.dg/controlled8.adb
new file mode 100644 (file)
index 0000000..d75bba6
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/controlled8.adb
@@ -0,0 +1,63 @@
+--  { dg-do compile }
+
+with Ada.Finalization; use Ada.Finalization;
+
+procedure Controlled8
+  (Int_Input : Integer;
+   Str_Input : String)
+is
+   type Ctrl is new Controlled with null record;
+   type Integer_Ptr is access all Integer;
+   type String_Ptr  is access all String;
+
+   function Func (Val : Integer) return Ctrl is
+   begin return Result : Ctrl; end Func;
+
+   function Func (Val : String) return Ctrl is
+   begin return Result : Ctrl; end Func;
+
+   type Rec_1 (Val : Integer) is record
+      Comp : Ctrl := Func (Val);
+   end record;
+
+   type Rec_2 (Val : access Integer) is record
+      Comp : Ctrl := Func (Val.all);
+   end record;
+
+   type Rec_3 (Val : Integer_Ptr) is record
+      Comp : Ctrl := Func (Val.all);
+   end record;
+
+   type Rec_4 (Val : access String) is record
+      Comp : Ctrl := Func (Val.all);
+   end record;
+
+   type Rec_5 (Val : String_Ptr) is record
+      Comp : Ctrl := Func (Val.all);
+   end record;
+
+   Int_Heap  : constant Integer_Ptr := new Integer'(Int_Input);
+   Int_Stack : aliased  Integer     := Int_Input;
+   Str_Heap  : constant String_Ptr  := new String'(Str_Input);
+   Str_Stack : aliased  String      := Str_Input;
+
+   Obj_1  : constant Rec_1 := (Val => Int_Input, others => <>);
+
+   Obj_2  : constant Rec_2 := (Val => Int_Heap, others => <>);
+   Obj_3  : constant Rec_2 := (Val => Int_Stack'Access, others => <>);
+   Obj_4  : constant Rec_2 := (Val => new Integer'(Int_Input), others => <>);
+
+   Obj_5  : constant Rec_3 := (Val => Int_Heap, others => <>);
+   Obj_6  : constant Rec_3 := (Val => Int_Stack'Access, others => <>);
+   Obj_7  : constant Rec_3 := (Val => new Integer'(Int_Input), others => <>);
+
+   Obj_8  : constant Rec_4 := (Val => Str_Heap, others => <>);
+   Obj_9  : constant Rec_4 := (Val => Str_Stack'Access, others => <>);
+   Obj_10 : constant Rec_4 := (Val => new String'(Str_Input), others => <>);
+
+   Obj_11 : constant Rec_5 := (Val => Str_Heap, others => <>);
+   Obj_12 : constant Rec_5 := (Val => Str_Stack'Access, others => <>);
+   Obj_13 : constant Rec_5 := (Val => new String'(Str_Input), others => <>);
+begin
+   null;
+end Controlled8;