From 02db8169939bb489abb6c7025395a3fc671b79b6 Mon Sep 17 00:00:00 2001 From: Hristian Kirtchev Date: Tue, 22 May 2018 13:26:55 +0000 Subject: [PATCH] [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 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 --- gcc/ada/ChangeLog | 7 +++ gcc/ada/exp_aggr.adb | 10 +++-- gcc/testsuite/ChangeLog | 4 ++ gcc/testsuite/gnat.dg/controlled8.adb | 63 +++++++++++++++++++++++++++ 4 files changed, 81 insertions(+), 3 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/controlled8.adb diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 3805c22cbed..effa9642a90 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2018-05-22 Hristian Kirtchev + + * 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 * 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 975d32ff359..356686e9df5 100644 --- 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 8df5df8882d..c5c26fda0d9 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2018-05-22 Hristian Kirtchev + + * gnat.dg/controlled8.adb: New testcase. + 2018-05-22 Patrick Bernardi * 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 index 00000000000..d75bba66536 --- /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; -- 2.30.2