From 7145d799a347800ea6ef5c5e3114db11469137a8 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Fri, 5 Jul 2019 07:02:32 +0000 Subject: [PATCH] [Ada] Spurious error on aggregate with choice that is predicted subtype This patch fixes a spurious error on a record aggregate for a variant record when a choice in the aggregate is given by a subtype with a static predicate. The same expansion mechanism for such a variant, used in case statements, must be used here as well. 2019-07-05 Ed Schonberg gcc/ada/ * sem_util.adb (Encloing_Subprogram): If Enclosing_Dynamic_Scope is a loop, continue climbing the scope stack to find the enclosing subprogram. (Gather_Components): Handle properly a choice in a record aggregate that is given by a subtype with a static predicate. gcc/testsuite/ * gnat.dg/aggr25.adb, gnat.dg/aggr25.ads: New testcase. From-SVN: r273112 --- gcc/ada/ChangeLog | 8 ++++++++ gcc/ada/sem_util.adb | 8 +++++++- gcc/testsuite/ChangeLog | 4 ++++ gcc/testsuite/gnat.dg/aggr25.adb | 7 +++++++ gcc/testsuite/gnat.dg/aggr25.ads | 23 +++++++++++++++++++++++ 5 files changed, 49 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gnat.dg/aggr25.adb create mode 100644 gcc/testsuite/gnat.dg/aggr25.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index ac29b9229ba..cac6be71dc2 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,11 @@ +2019-07-05 Ed Schonberg + + * sem_util.adb (Encloing_Subprogram): If Enclosing_Dynamic_Scope + is a loop, continue climbing the scope stack to find the + enclosing subprogram. + (Gather_Components): Handle properly a choice in a record + aggregate that is given by a subtype with a static predicate. + 2019-07-05 Javier Miranda * debug.adb (-gnatd.K): Leave available this switch. diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 55e64432a75..5c336940517 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -6895,7 +6895,7 @@ package body Sem_Util is elsif Ekind (Dyn_Scop) = E_Subprogram_Body then return Corresponding_Spec (Parent (Parent (Dyn_Scop))); - elsif Ekind_In (Dyn_Scop, E_Block, E_Return_Statement) then + elsif Ekind_In (Dyn_Scop, E_Block, E_Return_Statement, E_Loop) then return Enclosing_Subprogram (Dyn_Scop); elsif Ekind (Dyn_Scop) = E_Entry then @@ -8939,6 +8939,12 @@ package body Sem_Util is begin Find_Discrete_Value : while Present (Variant) loop + + -- If a choice is a subtype with a static predicate, it must + -- be rewritten as an explicit list of non-predicated choices. + + Expand_Static_Predicates_In_Choices (Variant); + Discrete_Choice := First (Discrete_Choices (Variant)); while Present (Discrete_Choice) loop exit Find_Discrete_Value when diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index d5905f00a75..82b8c22901c 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2019-07-05 Ed Schonberg + + * gnat.dg/aggr25.adb, gnat.dg/aggr25.ads: New testcase. + 2019-07-05 Ed Schonberg * gnat.dg/predicate7.adb, gnat.dg/predicate7.ads, diff --git a/gcc/testsuite/gnat.dg/aggr25.adb b/gcc/testsuite/gnat.dg/aggr25.adb new file mode 100644 index 00000000000..d1bb32a13b4 --- /dev/null +++ b/gcc/testsuite/gnat.dg/aggr25.adb @@ -0,0 +1,7 @@ +-- { dg-do compile } + +package body Aggr25 is + + procedure Foo is null; + +end Aggr25; diff --git a/gcc/testsuite/gnat.dg/aggr25.ads b/gcc/testsuite/gnat.dg/aggr25.ads new file mode 100644 index 00000000000..5637cfeec36 --- /dev/null +++ b/gcc/testsuite/gnat.dg/aggr25.ads @@ -0,0 +1,23 @@ +package Aggr25 is + + type T_A is (A, B , C ,D); + + subtype Has_B_D is T_A with Static_Predicate => Has_B_D in B | D; + + type Obj_T (Kind : T_A) is + record + case Kind is + --OK-- when A | C => null; --OK-- + when Has_B_D => Value : Boolean; + --BAD-- when A | C => null; + when others => null; + end case; + end record; + + type T is access Obj_T; + + Unavailable : constant T := new Obj_T'(Kind => A); + + procedure Foo; + +end Aggr25; -- 2.30.2