From: Javier Miranda Date: Tue, 21 Aug 2018 14:44:35 +0000 (+0000) Subject: [Ada] Enumeration types with non-standard representation X-Git-Tag: basepoints/gcc-10~4652 X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=f20b5ef46d7338e626286721a74e3fd3385e8be0;p=thirdparty%2Fgcc.git [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 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 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index dcbec9b9320c..11613943f992 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,12 @@ +2018-08-21 Javier Miranda + + * 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 * lib-xref.ads, lib-xref-spark_specific.adb diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 871f1f73bdd8..f399cda780c3 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 85affc430008..f2eed3dbcb50 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 42117a60523e..13faad8a1dcc 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2018-08-21 Javier Miranda + + * gnat.dg/enum4.adb: New testcase. + 2018-08-21 Tamar Christina * 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 000000000000..e8d743ec1d39 --- /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;