[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 3805c22cbeda95859a92d24111fbe202d480f62d..effa9642a90d411d7d8d7041f8b86dc18c41c482 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 975d32ff3597372d77ce90bf0d54be31849cfb58..356686e9df5d64cb3dc779d720dec1296d0d9a25 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 8df5df8882d4d2f041463e2fcee98150cc884464..c5c26fda0d92fb6bce21eb1d486724b68d098eb9 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;