From: Eric Botcazou <ebotcazou@adacore.com>
Date: Mon, 22 Jul 2019 13:57:04 +0000 (+0000)
Subject: [Ada] Fix missing Constraint_Error for Enum_Val attribute
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=fd90c808628cead705bb4521d9b8beea0edcf2bf;p=gcc.git

[Ada] Fix missing Constraint_Error for Enum_Val attribute

This fixes an old issue involving the Enum_Val attribute: it does not
always raise a Constraint_Error exception when the specified value is
not valid for the enumeration type (instead a modulo computation is
applied to the value).

2019-07-22  Eric Botcazou  <ebotcazou@adacore.com>

gcc/ada/

	* exp_attr.adb (Expand_N_Attribute_Reference)
	<Attribute_Enum_Val>: Set No_Truncation on the
	N_Unchecked_Type_Conversion built around the argument passed to
	the attribute.

gcc/testsuite/

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

From-SVN: r273676
---

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 276fdba9852..85a0a268b22 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,10 @@
+2019-07-22  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* exp_attr.adb (Expand_N_Attribute_Reference)
+	<Attribute_Enum_Val>: Set No_Truncation on the
+	N_Unchecked_Type_Conversion built around the argument passed to
+	the attribute.
+
 2019-07-22  Nicolas Roche  <roche@adacore.com>
 
 	* libgnat/s-valrea.adb (Scan_Real): Ignore non significative
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 90ca8ffbd8d..2748c519b42 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -3282,6 +3282,13 @@ package body Exp_Attr is
 
          Expr := Unchecked_Convert_To (Ptyp, First (Exprs));
 
+         --  Ensure that the expression is not truncated since the "bad" bits
+         --  are desired.
+
+         if Nkind (Expr) = N_Unchecked_Type_Conversion then
+            Set_No_Truncation (Expr);
+         end if;
+
          Insert_Action (N,
            Make_Raise_Constraint_Error (Loc,
              Condition =>
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index d49f01851d3..da0bf2a8918 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2019-07-22  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gnat.dg/enum_val1.adb: New testcase.
+
 2019-07-22  Nicolas Roche  <roche@adacore.com>
 
 	* gnat.dg/float_value1.adb: New testcase.
diff --git a/gcc/testsuite/gnat.dg/enum_val1.adb b/gcc/testsuite/gnat.dg/enum_val1.adb
new file mode 100644
index 00000000000..4550c11097c
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/enum_val1.adb
@@ -0,0 +1,22 @@
+with Ada.Text_IO; use Ada.Text_IO;
+
+procedure Enum_Val1 is
+   type Enum is (Two, Four);
+   for Enum use (2, 4);
+
+   Count : Natural := 0;
+
+begin
+   for I in 10 .. 11 loop
+      begin
+         Put (Integer'Image (I) & ": ");
+         Put_Line (Enum'Image (Enum'Enum_Val (I)));
+      exception
+         when Constraint_Error =>
+            Count := Count + 1;
+      end;
+   end loop;
+   if Count /= 2 then
+      raise Program_Error;
+   end if;
+end;