From 4669743bd255d2ab4ff33672e8843a914e5c1d35 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Wed, 10 Jul 2019 09:02:55 +0000 Subject: [PATCH] [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 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 | 6 ++++++ gcc/ada/sem_ch2.adb | 21 ++++++++++++++++++++- gcc/testsuite/ChangeLog | 4 ++++ gcc/testsuite/gnat.dg/modular5.adb | 26 ++++++++++++++++++++++++++ 4 files changed, 56 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gnat.dg/modular5.adb diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 996dd18d2ba..94fab7f5578 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2019-07-10 Ed Schonberg + + * 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 * init.c: Do not attempt to re-arm guard page on x86_64-vx7(r2). diff --git a/gcc/ada/sem_ch2.adb b/gcc/ada/sem_ch2.adb index 3b46ad51512..0a282d443d9 100644 --- a/gcc/ada/sem_ch2.adb +++ b/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; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index e2dc5fe3847..a953397db93 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2019-07-10 Ed Schonberg + + * gnat.dg/modular5.adb: New testcase. + 2019-07-10 Ed Schonberg * gnat.dg/limited3.adb, gnat.dg/limited3_pkg.adb, diff --git a/gcc/testsuite/gnat.dg/modular5.adb b/gcc/testsuite/gnat.dg/modular5.adb new file mode 100644 index 00000000000..7fcf59ce849 --- /dev/null +++ b/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; -- 2.30.2