[Ada] Spurious run-time error with 64-bit modular types

As a lexical element an integer literal has type Universal_Integer, i.e
is compatible with any integer type. This is semantically consistent and
simplifies type checking and subsequent constant folding when
applicable.  An exception is caused by 64-bit modular types, whose upper
bound is not representable in a non-static context that will use 64-bit
integers at run-time. For such cases we need to preserve the information
that the analyzed literal has that modular type. For simplicity we
preseve the information for all integer literals that result from a
modular operation.  This happens after prior analysis (or construction)
of the literal, and after type checking and resolution.

2019-07-10  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* sem_ch2.adb (Analyze_Integer_Literal): Preserve the type of
	the literal if prior analysis determined that its type is a
	modular integer type.

gcc/testsuite/

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

From-SVN: r273352

gcc/ada/ChangeLog

@@ -1,3 +1,9 @@
+2019-07-10  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch2.adb (Analyze_Integer_Literal): Preserve the type of
+	the literal if prior analysis determined that its type is a
+	modular integer type.
+
 2019-07-10  Doug Rupp  <rupp@adacore.com>
 
 	* init.c: Do not attempt to re-arm guard page on x86_64-vx7(r2).

gcc/ada/sem_ch2.adb

@@ -24,12 +24,14 @@
 ------------------------------------------------------------------------------
 
 with Atree;    use Atree;
+with Einfo;    use Einfo;
 with Namet;    use Namet;
 with Opt;      use Opt;
 with Restrict; use Restrict;
 with Rident;   use Rident;
 with Sem_Ch8;  use Sem_Ch8;
 with Sem_Dim;  use Sem_Dim;
+--  with Sem_Util; use Sem_Util;
 with Sinfo;    use Sinfo;
 with Stand;    use Stand;
 with Uintp;    use Uintp;
@@ -83,7 +85,24 @@ package body Sem_Ch2 is
 
    procedure Analyze_Integer_Literal (N : Node_Id) is
    begin
-      Set_Etype (N, Universal_Integer);
+      --  As a lexical element, an integer literal has type Universal_Integer,
+      --  i.e., is compatible with any integer type. This is semantically
+      --  consistent and simplifies type checking and subsequent constant
+      --  folding when needed. An exception is caused by 64-bit modular types,
+      --  whose upper bound is not representable in a nonstatic context that
+      --  will use 64-bit integers at run time. For such cases, we need to
+      --  preserve the information that the analyzed literal has that modular
+      --  type. For simplicity, we preserve the information for all integer
+      --  literals that result from a modular operation. This happens after
+      --  prior analysis (or construction) of the literal, and after type
+      --  checking and resolution.
+
+      if No (Etype (N))
+        or else not Is_Modular_Integer_Type (Etype (N))
+      then
+         Set_Etype (N, Universal_Integer);
+      end if;
+
       Set_Is_Static_Expression (N);
    end Analyze_Integer_Literal;
 

gcc/testsuite/ChangeLog

@@ -1,3 +1,7 @@
+2019-07-10  Ed Schonberg  <schonberg@adacore.com>
+
+	* gnat.dg/modular5.adb: New testcase.
+
 2019-07-10  Ed Schonberg  <schonberg@adacore.com>
 
 	* gnat.dg/limited3.adb, gnat.dg/limited3_pkg.adb,

gcc/testsuite/gnat.dg/modular5.adb

@@ -0,0 +1,26 @@
+-- { dg-do compile }
+-- { dg-options "-gnata" }
+
+procedure Modular5 is
+   type U64 is mod 2 ** 64;
+   Maybe    : Boolean := 2 ** 10 < U64'Succ (U64'last - 1);
+   For_Sure : Boolean := U64'(18446744073709551615) > 2;
+   Ditto    : Boolean := 18446744073709551615 > 2;
+
+   generic
+      type TG is mod <>;
+   package PG is
+     X : TG;
+      pragma Assert (for all K in 1 .. 2 => 2 ** K <= TG'Last);
+      pragma Assert (for all K in 1 .. 2 => 2 ** K <= TG'Last - 1);
+
+     Maybe    : Boolean := 2 ** 10 < TG'Succ (TG'last - 1);
+     For_Sure : Boolean := TG'(18446744073709551615) > 2;
+   end PG;
+
+   package IG is new PG (U64);
+
+begin
+   pragma Assert (for all K in 1 .. 2 => 2 ** K <= U64'Last);
+   pragma Assert (for all K in 1 .. 2 => 2 ** K <= U64'Last - 1);
+end Modular5;