From: Bob Duff Date: Wed, 14 Aug 2019 09:51:43 +0000 (+0000) Subject: [Ada] Spurious error in discriminated aggregate X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=f056076f5fe77fe8b13050eb3affc4c8ac700722;p=gcc.git [Ada] Spurious error in discriminated aggregate This patch fixes a bug in which a spurious error is given on an aggregate of a type derived from a subtype with a constrained discriminant. 2019-08-14 Bob Duff gcc/ada/ * exp_aggr.adb (Init_Hidden_Discriminants): Avoid processing the wrong discriminant, which could be of the wrong type. gcc/testsuite/ * gnat.dg/discr57.adb: New testcase. From-SVN: r274458 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index a36a83ab3d2..785d9d88f1e 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2019-08-14 Bob Duff + + * exp_aggr.adb (Init_Hidden_Discriminants): Avoid processing the + wrong discriminant, which could be of the wrong type. + 2019-08-14 Eric Botcazou * sem_ch12.adb (Analyze_Instance_And_Renamings): Do not reset diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 174da6eb63e..6a756fda682 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -2689,8 +2689,10 @@ package body Exp_Aggr is Discr_Constr := First_Elmt (Stored_Constraint (Full_View (Base_Typ))); + -- Otherwise, no discriminant to process + else - Discr_Constr := First_Elmt (Stored_Constraint (Typ)); + Discr_Constr := No_Elmt; end if; while Present (Discr) and then Present (Discr_Constr) loop diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 89a92fa2583..dadeb4fecc0 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2019-08-14 Bob Duff + + * gnat.dg/discr57.adb: New testcase. + 2019-08-14 Eric Botcazou * gnat.dg/generic_inst11.adb, gnat.dg/generic_inst11_pkg.adb, diff --git a/gcc/testsuite/gnat.dg/discr57.adb b/gcc/testsuite/gnat.dg/discr57.adb new file mode 100644 index 00000000000..cb5cecca92c --- /dev/null +++ b/gcc/testsuite/gnat.dg/discr57.adb @@ -0,0 +1,17 @@ +-- { dg-do compile } + +procedure Discr57 is + + type T1(Scalar : Boolean) is abstract tagged null record; + + subtype S1 is T1 (Scalar => False); + + type T2(Lower_Bound : Natural) is new + S1 with null record; + + Obj : constant T2 := + (Lower_Bound => 123); + +begin + null; +end Discr57;