[Ada] Enumeration types with non-standard representation

The compiler may report errors on enumeration types with non-standard
representation (i.e. at least one literal has a representation value
different from its 'Pos value) processing attribute 'Enum_Rep.

It may also generate wrong code for the evaluation of 'Enum_Rep raising
Constraint_Error at runtime.

2018-08-21  Javier Miranda  <miranda@adacore.com>

gcc/ada/

	* checks.ads (Determine_Range): Adding documentation.
	* checks.adb (Determine_Range): Don't deal with enumerated types
	with non-standard representation.
	(Convert_And_Check_Range): For conversion of enumeration types
	with non standard representation to an integer type perform a
	direct conversion to the target integer type.

gcc/testsuite/

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

From-SVN: r263708

5 files changed, 116 insertions, 13 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index dcbec9b..1161394 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,12 @@
+2018-08-21  Javier Miranda  <miranda@adacore.com>
+
+	* checks.ads (Determine_Range): Adding documentation.
+	* checks.adb (Determine_Range): Don't deal with enumerated types
+	with non-standard representation.
+	(Convert_And_Check_Range): For conversion of enumeration types
+	with non standard representation to an integer type perform a
+	direct conversion to the target integer type.
+
 2018-08-21  Piotr Trojanek  <trojanek@adacore.com>
 
 	* lib-xref.ads, lib-xref-spark_specific.adb
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index 871f1f7..f399cda 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -4490,6 +4490,11 @@ package body Checks is
 
         or else not Is_Discrete_Type (Typ)
 
+        --  Don't deal with enumerated types with non-standard representation
+
+        or else (Is_Enumeration_Type (Typ)
+                   and then Present (Enum_Pos_To_Rep (Base_Type (Typ))))
+
         --  Ignore type for which an error has been posted, since range in
         --  this case may well be a bogosity deriving from the error. Also
         --  ignore if error posted on the reference node.
@@ -6758,9 +6763,36 @@ package body Checks is
       -----------------------------
 
       procedure Convert_And_Check_Range is
-         Tnn : constant Entity_Id := Make_Temporary (Loc, 'T', N);
+         Tnn       : constant Entity_Id := Make_Temporary (Loc, 'T', N);
+         Conv_Node : Node_Id;
 
       begin
+         --  For enumeration types with non-standard representation this is a
+         --  direct conversion from the enumeration type to the target integer
+         --  type, which is treated by the back end as a normal integer type
+         --  conversion, treating the enumeration type as an integer, which is
+         --  exactly what we want. We set Conversion_OK to make sure that the
+         --  analyzer does not complain about what otherwise might be an
+         --  illegal conversion.
+
+         if Is_Enumeration_Type (Source_Base_Type)
+           and then Present (Enum_Pos_To_Rep (Source_Base_Type))
+           and then Is_Integer_Type (Target_Base_Type)
+         then
+            Conv_Node :=
+              OK_Convert_To (
+                Typ  => Target_Base_Type,
+                Expr => Duplicate_Subexpr (N));
+
+         --  Common case
+
+         else
+            Conv_Node :=
+              Make_Type_Conversion (Loc,
+                Subtype_Mark => New_Occurrence_Of (Target_Base_Type, Loc),
+                Expression   => Duplicate_Subexpr (N));
+         end if;
+
          --  We make a temporary to hold the value of the converted value
          --  (converted to the base type), and then do the test against this
          --  temporary. The conversion itself is replaced by an occurrence of
@@ -6776,10 +6808,7 @@ package body Checks is
              Defining_Identifier => Tnn,
              Object_Definition   => New_Occurrence_Of (Target_Base_Type, Loc),
              Constant_Present    => True,
-             Expression          =>
-               Make_Type_Conversion (Loc,
-                 Subtype_Mark => New_Occurrence_Of (Target_Base_Type, Loc),
-                 Expression   => Duplicate_Subexpr (N))),
+             Expression          => Conv_Node),
 
            Make_Raise_Constraint_Error (Loc,
              Condition =>
diff --git a/gcc/ada/checks.ads b/gcc/ada/checks.ads
index 85affc4..f2eed3d 100644
--- a/gcc/ada/checks.ads
+++ b/gcc/ada/checks.ads
@@ -310,14 +310,16 @@ package Checks is
    --  then OK is True on return, and Lo and Hi are set to a conservative
    --  estimate of the possible range of values of N. Thus if OK is True on
    --  return, the value of the subexpression N is known to lie in the range
-   --  Lo .. Hi (inclusive). If the expression is not of a discrete type, or
-   --  some kind of error condition is detected, then OK is False on exit, and
-   --  Lo/Hi are set to No_Uint. Thus the significance of OK being False on
-   --  return is that no useful information is available on the range of the
-   --  expression. Assume_Valid determines whether the processing is allowed to
-   --  assume that values are in range of their subtypes. If it is set to True,
-   --  then this assumption is valid, if False, then processing is done using
-   --  base types to allow invalid values.
+   --  Lo .. Hi (inclusive). For enumeration and character literals the values
+   --  returned are the Pos value in the relevant enumeration type. If the
+   --  expression is not of a discrete type, or some kind of error condition
+   --  is detected, then OK is False on exit, and Lo/Hi are set to No_Uint.
+   --  Thus the significance of OK being False on return is that no useful
+   --  information is available on the range of the expression. Assume_Valid
+   --  determines whether the processing is allowed to assume that values are
+   --  in range of their subtypes. If it is set to True, then this assumption
+   --  is valid, if False, then processing is done using base types to allow
+   --  invalid values.
 
    procedure Determine_Range_R
      (N            : Node_Id;
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 42117a6..13faad8 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2018-08-21  Javier Miranda  <miranda@adacore.com>
+
+	* gnat.dg/enum4.adb: New testcase.
+
 2018-08-21  Tamar Christina  <tamar.christina@arm.com>
 
 	* gcc.target/aarch64/large_struct_copy.c: New test.
diff --git a/gcc/testsuite/gnat.dg/enum4.adb b/gcc/testsuite/gnat.dg/enum4.adb
new file mode 100644
index 0000000..e8d743e
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/enum4.adb
@@ -0,0 +1,59 @@
+--  { dg-do run }
+
+procedure Enum4 is
+
+   procedure Assert (Expected, Actual : String) is
+   begin
+      if Expected /= Actual then
+         raise Program_Error;
+      end if;
+   end Assert;
+
+   procedure Test_1 is
+      type Test_Enum is (Enum_1,     Enum_2);
+      for Test_Enum use (Enum_1=> 8, Enum_2=> 12);
+
+      Enum_Values : constant array (Test_Enum) of Natural := (8, 12);
+
+      type Test_Enum_Rep is range 1..12;
+      Tmp_Test_Enum_Rep : Test_Enum_Rep;
+   begin
+      Tmp_Test_Enum_Rep := Test_Enum'Enum_Rep (Test_Enum'First);
+      Assert (" 8", Tmp_Test_Enum_Rep'Img);
+
+      for Enum in Test_Enum loop
+         Tmp_Test_Enum_Rep := Test_Enum'Enum_Rep (Enum);
+         Assert (Enum_Values (Enum)'Img, Tmp_Test_Enum_Rep'Img);
+      end loop;
+   end Test_1;
+
+   procedure Test_2 is
+      type Test_Enum is (Enum_1);
+      for Test_Enum use (Enum_1=> 2);
+
+      type Test_Enum_Rep_Full is range 0..2;
+      subtype Test_Enum_Rep_Short is
+        Test_Enum_Rep_Full range 2..Test_Enum_Rep_Full'Last;
+
+      Tmp_Test_Enum_Rep_Full  : Test_Enum_Rep_Full;
+      Tmp_Test_Enum_Rep_Short : Test_Enum_Rep_Short;
+
+   begin
+      Tmp_Test_Enum_Rep_Short := Test_Enum'Enum_Rep (Test_Enum'First);
+      Assert (" 2", Tmp_Test_Enum_Rep_Short'Img);
+
+      for Enum in Test_Enum loop
+         Tmp_Test_Enum_Rep_Full := Test_Enum'Enum_Rep (Enum);
+         Assert (" 2", Tmp_Test_Enum_Rep_Short'Img);
+      end loop;
+
+      for Enum in Test_Enum range Test_Enum'First .. Test_Enum'Last loop
+         Tmp_Test_Enum_Rep_Short := Test_Enum'Enum_Rep(Enum);  --  Test #2
+         Assert (" 2", Tmp_Test_Enum_Rep_Short'Img);
+      end loop;
+   end Test_2;
+
+begin
+   Test_1;
+   Test_2;
+end;