From: Ed Schonberg Date: Wed, 3 Jul 2019 08:14:47 +0000 (+0000) Subject: [Ada] Spurious error with static predicate in generic unit X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=558241c0f71b4171c471100631af79aa93c0a9e7;p=gcc.git [Ada] Spurious error with static predicate in generic unit This patch fixes a spurious error in a generic unit that invludes a subtype with a static predicate, when the type is used in a case expression. 2019-07-03 Ed Schonberg gcc/ada/ * sem_ch13.adb (Build_Predicate_Functions): In a generic context we do not build the bodies of predicate fuctions, but the expression in a static predicate must be elaborated to allow case coverage checking within the generic unit. (Build_Discrete_Static_Predicate): In a generic context, return without building function body once the Static_Discrete_Predicate expression for the type has been constructed. gcc/testsuite/ * gnat.dg/predicate6.adb, gnat.dg/predicate6.ads: New testcase. * gnat.dg/static_pred1.adb: Remove expected error. From-SVN: r272974 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 7879ba2215c..6326e7cfa2d 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,14 @@ +2019-07-03 Ed Schonberg + + * sem_ch13.adb (Build_Predicate_Functions): In a generic context + we do not build the bodies of predicate fuctions, but the + expression in a static predicate must be elaborated to allow + case coverage checking within the generic unit. + (Build_Discrete_Static_Predicate): In a generic context, return + without building function body once the + Static_Discrete_Predicate expression for the type has been + constructed. + 2019-07-03 Hristian Kirtchev * bindgen.adb, inline.adb, layout.adb, sem_ch12.adb, diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 234177f556f..6d9b09db08e 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -8201,6 +8201,13 @@ package body Sem_Ch13 is Set_Static_Discrete_Predicate (Typ, Plist); + -- Within a generic the predicate functions themselves need not + -- be constructed. + + if Inside_A_Generic then + return; + end if; + -- The processing for static predicates put the expression into -- canonical form as a series of ranges. It also eliminated -- duplicates and collapsed and combined ranges. We might as well @@ -8733,9 +8740,13 @@ package body Sem_Ch13 is -- Do not generate predicate bodies within a generic unit. The -- expressions have been analyzed already, and the bodies play - -- no role if not within an executable unit. + -- no role if not within an executable unit. However, if a statc + -- predicate is present it must be processed for legality checks + -- such as case coverage in an expression. - elsif Inside_A_Generic then + elsif Inside_A_Generic + and then not Has_Static_Predicate_Aspect (Typ) + then return; end if; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 058b533ba77..de7b7ad89e8 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2019-07-03 Ed Schonberg + + * gnat.dg/predicate6.adb, gnat.dg/predicate6.ads: New testcase. + * gnat.dg/static_pred1.adb: Remove expected error. + 2019-07-03 Ed Schonberg * gnat.dg/predicate5.adb, gnat.dg/predicate5.ads: New testcase. diff --git a/gcc/testsuite/gnat.dg/predicate6.adb b/gcc/testsuite/gnat.dg/predicate6.adb new file mode 100644 index 00000000000..f098569df04 --- /dev/null +++ b/gcc/testsuite/gnat.dg/predicate6.adb @@ -0,0 +1,5 @@ +-- { dg-do compile } + +package body Predicate6 is + procedure Foo is null; +end Predicate6; diff --git a/gcc/testsuite/gnat.dg/predicate6.ads b/gcc/testsuite/gnat.dg/predicate6.ads new file mode 100644 index 00000000000..91e0adc87ef --- /dev/null +++ b/gcc/testsuite/gnat.dg/predicate6.ads @@ -0,0 +1,10 @@ +generic +package Predicate6 is + type Price_Kind is (Infinitely_Small, Normal, Infinitely_Large); + subtype Infinite_Kind is Price_Kind with Static_Predicate => + Infinite_Kind in Infinitely_Small | Infinitely_Large; + function "not" (Kind : Infinite_Kind) return Infinite_Kind is + (case Kind is when Infinitely_Small => Infinitely_Large, + when Infinitely_Large => Infinitely_Small); + procedure Foo; +end; diff --git a/gcc/testsuite/gnat.dg/static_pred1.adb b/gcc/testsuite/gnat.dg/static_pred1.adb index 5b32a5ca509..16bbde2c65b 100644 --- a/gcc/testsuite/gnat.dg/static_pred1.adb +++ b/gcc/testsuite/gnat.dg/static_pred1.adb @@ -8,7 +8,7 @@ package body Static_Pred1 is Enum_Subrange in A | C; function "not" (Kind : Enum_Subrange) return Enum_Subrange is - (case Kind is -- { dg-error "missing case value: \"B\"" } + (case Kind is when A => C, when C => A);