From fd90c808628cead705bb4521d9b8beea0edcf2bf Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Mon, 22 Jul 2019 13:57:04 +0000 Subject: [PATCH] [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 gcc/ada/ * exp_attr.adb (Expand_N_Attribute_Reference) : 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 --- gcc/ada/ChangeLog | 7 +++++++ gcc/ada/exp_attr.adb | 7 +++++++ gcc/testsuite/ChangeLog | 4 ++++ gcc/testsuite/gnat.dg/enum_val1.adb | 22 ++++++++++++++++++++++ 4 files changed, 40 insertions(+) create mode 100644 gcc/testsuite/gnat.dg/enum_val1.adb 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 + + * exp_attr.adb (Expand_N_Attribute_Reference) + : Set No_Truncation on the + N_Unchecked_Type_Conversion built around the argument passed to + the attribute. + 2019-07-22 Nicolas Roche * 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 + + * gnat.dg/enum_val1.adb: New testcase. + 2019-07-22 Nicolas Roche * 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; -- 2.30.2