[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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 7879ba2215c4ec2c7b0ac023b6a68a8200bb3507..6326e7cfa2df9712dbc5699286495a854d610eae 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -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,

diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 234177f556f1c7a2d7d6513ea7e7e68b6b3c2743..6d9b09db08e188f96931c1a8e1a5b04b58c866b7 100644 (file)
--- 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 058b533ba773f1f9d1940b9dd448f89166953e57..de7b7ad89e8ce0753c955e5f31ed314f61bccdfc 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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.

diff --git a/gcc/testsuite/gnat.dg/predicate6.adb b/gcc/testsuite/gnat.dg/predicate6.adb
new file mode 100644 (file)
index 0000000..f098569
--- /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 (file)
index 0000000..91e0adc
--- /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 5b32a5ca5091eb7f6a1208491bd43d616071e8a3..16bbde2c65be3ba937b51083f6821b658b35ffab 100644 (file)
--- 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);