[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  <schonberg@adacore.com>

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
This commit is contained in:
Ed Schonberg 2019-07-03 08:14:47 +00:00 committed by Pierre-Marie de Rodat
parent b5c8da6bac
commit 558241c0f7
6 changed files with 45 additions and 3 deletions

View File

@ -1,3 +1,14 @@
2019-07-03 Ed Schonberg <schonberg@adacore.com>
* 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 <kirtchev@adacore.com>
* bindgen.adb, inline.adb, layout.adb, sem_ch12.adb,

View File

@ -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;

View File

@ -1,3 +1,8 @@
2019-07-03 Ed Schonberg <schonberg@adacore.com>
* gnat.dg/predicate6.adb, gnat.dg/predicate6.ads: New testcase.
* gnat.dg/static_pred1.adb: Remove expected error.
2019-07-03 Ed Schonberg <schonberg@adacore.com>
* gnat.dg/predicate5.adb, gnat.dg/predicate5.ads: New testcase.

View File

@ -0,0 +1,5 @@
-- { dg-do compile }
package body Predicate6 is
procedure Foo is null;
end Predicate6;

View File

@ -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;

View File

@ -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);