[Ada] Implement AI12-0086's rules for discriminants in aggregates

In Ada2012, a discriminant value that governs an active variant part in
an aggregate had to be static. AI12-0086 relaxes this restriction - if
the subtype of the discriminant value is a static subtype all of whose
values select the same variant, then that is good enough.

2019-09-18  Steve Baird  <baird@adacore.com>

gcc/ada/

	* sem_util.ads (Interval_Lists): A new visible package. This
	package is visible because it is also intended for eventual use
	in Sem_Eval.Subtypes_Statically_Compatible when that function is
	someday upgraded to handle static predicates correctly.  This
	new package doesn't really need to be visible for now, but it
	still seems like a good idea.
	* sem_util.adb (Gather_Components): Implement AI12-0086 via the
	following strategy. The existing code knows how to take a static
	discriminant value and identify the corresponding variant; in
	the newly-permitted case of a non-static value of a static
	subtype, we arbitrarily select a value of the subtype and find
	the corresponding variant using the existing code. Subsequently,
	we check that every other value of the discriminant's subtype
	corresponds to the same variant; this is done using the newly
	introduced Interval_Lists package.
	(Interval_Lists): Provide a body for the new package.

gcc/testsuite/

	* gnat.dg/ai12_0086_example.adb: New testcase.

From-SVN: r275857

gcc/ada/ChangeLog

+2019-09-18  Steve Baird  <baird@adacore.com>
+
+	* sem_util.ads (Interval_Lists): A new visible package. This
+	package is visible because it is also intended for eventual use
+	in Sem_Eval.Subtypes_Statically_Compatible when that function is
+	someday upgraded to handle static predicates correctly.  This
+	new package doesn't really need to be visible for now, but it
+	still seems like a good idea.
+	* sem_util.adb (Gather_Components): Implement AI12-0086 via the
+	following strategy. The existing code knows how to take a static
+	discriminant value and identify the corresponding variant; in
+	the newly-permitted case of a non-static value of a static
+	subtype, we arbitrarily select a value of the subtype and find
+	the corresponding variant using the existing code. Subsequently,
+	we check that every other value of the discriminant's subtype
+	corresponds to the same variant; this is done using the newly
+	introduced Interval_Lists package.
+	(Interval_Lists): Provide a body for the new package.
+
 2019-09-18  Javier Miranda  <miranda@adacore.com>
 
 	* exp_ch4.adb (Expand_N_Op_Eq): The frontend assumes that we can

gcc/ada/sem_util.ads

@@ -2965,4 +2965,40 @@ package Sem_Util is
    function Yields_Universal_Type (N : Node_Id) return Boolean;
    --  Determine whether unanalyzed node N yields a universal type
 
+   package Interval_Lists is
+      type Discrete_Interval is
+         record
+            Low, High : Uint;
+         end record;
+
+      type Discrete_Interval_List is
+        array (Pos range <>) of Discrete_Interval;
+      --  A sorted (in ascending order) list of non-empty pairwise-disjoint
+      --  intervals, always with a gap of at least one value between
+      --  successive intervals (i.e., mergeable intervals are merged).
+      --  Low bound is one; high bound is nonnegative.
+
+      function Type_Intervals (Typ : Entity_Id) return Discrete_Interval_List;
+      --  Given a static discrete type or subtype, returns the (unique)
+      --  interval list representing the values of the type/subtype.
+      --  If no static predicates are involved, the length of the result
+      --  will be at most one.
+
+      function Choice_List_Intervals (Discrete_Choices : List_Id)
+                                     return Discrete_Interval_List;
+      --  Given a discrete choice list, returns the (unique) interval
+      --  list representing the chosen values..
+
+      function Is_Subset (Subset, Of_Set : Discrete_Interval_List)
+        return Boolean;
+      --  Returns True iff every value belonging to some interval of
+      --  Subset also belongs to some interval of Of_Set.
+
+      --  TBD: When we get around to implementing "is statically compatible"
+      --  correctly for real types with static predicates, we may need
+      --  an analogous Real_Interval_List type. Most of the language
+      --  rules that reference "is statically compatible" pertain to
+      --  discriminants and therefore do require support for real types;
+      --  the exception is 12.5.1(8).
+   end Interval_Lists;
 end Sem_Util;

gcc/testsuite/ChangeLog

+2019-09-18  Steve Baird  <baird@adacore.com>
+
+	* gnat.dg/ai12_0086_example.adb: New testcase.
+
 2019-09-18  Nicolas Roche  <roche@adacore.com>
 
 	* gnat.dg/float_value2.adb: New testcase.

gcc/testsuite/gnat.dg/ai12_0086_example.adb

+--  { dg-do compile }
+--  { dg-options "-gnatX" }
+
+procedure AI12_0086_Example is
+    type Enum is (Aa, Bb, Cc, Dd, Ee, Ff, Gg, Hh, Ii, Jj, Kk, Ll, MM,
+                  Nn, Oo, Pp, Qq, Rr, Ss, Tt, Uu, Vv, Ww, Xx, Yy, Zz);
+    subtype S is Enum range Dd .. Hh;
+
+    type Rec (D : Enum) is record
+      case D is
+        when S => Foo, Bar : Integer;
+        when others => null;
+      end case;
+    end record;
+
+    function Make (D : S) return Rec is
+    begin
+      return (D => D, Foo => 123, Bar => 456); -- legal
+    end;
+begin
+    if Make (Ff).Bar /= 456 then
+       raise Program_Error;
+    end if;
+end AI12_0086_Example;
\ No newline at end of file