This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[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.

Tested on x86_64-pc-linux-gnu, committed on trunk

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.
--- gcc/ada/sem_ch13.adb
+++ 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;
 

--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/predicate6.adb
@@ -0,0 +1,5 @@
+--  { dg-do compile }
+
+package body Predicate6 is
+   procedure Foo is null;
+end Predicate6;

--- /dev/null
new file mode 100644
+++ 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;

--- gcc/testsuite/gnat.dg/static_pred1.adb
+++ 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);
 


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]