This changes the front-end to expand the 'Pos and 'Val attributes for
enumeration types with standard representation. It turns out that this
was the only remaining case where it does not expand them, as it does
so for enumeration types with non-standard representation as well as
for integer types.
Besides fixing the irregularity, this makes it possible to narrow the
computations in which these attributes are involved, since they either
return or take a value of Universal_Integer type nominally.
Tested on x86_64-pc-linux-gnu, committed on trunk
2020-06-16 Eric Botcazou <ebotca...@adacore.com>
gcc/ada/
* sinfo.ads (Conversion_OK): Document use for 'Pos and 'Val.
* exp_attr.adb (Get_Integer_Type): New function returning a
small integer type appropriate for an enumeration type.
(Expand_N_Attribute_Reference) <Attribute_Enum_Rep>: Call it.
<Attribute_Pos>: For an enumeration type with a standard
representation, expand to a conversion with Conversion_OK.
<Attribute_Val>: Likewise.
* exp_ch4.adb (Expand_N_Type_Conversion): Do not expand when
the target is an enumeration type and Conversion_OK is set.--- gcc/ada/exp_attr.adb
+++ gcc/ada/exp_attr.adb
@@ -1737,11 +1737,41 @@ package body Exp_Attr is
Pref : constant Node_Id := Prefix (N);
Exprs : constant List_Id := Expressions (N);
+ function Get_Integer_Type (Typ : Entity_Id) return Entity_Id;
+ -- Return a small integer type appropriate for the enumeration type
+
procedure Rewrite_Attribute_Proc_Call (Pname : Entity_Id);
-- Rewrites an attribute for Read, Write, Output, or Put_Image with a
-- call to the appropriate TSS procedure. Pname is the entity for the
-- procedure to call.
+ ----------------------
+ -- Get_Integer_Type --
+ ----------------------
+
+ function Get_Integer_Type (Typ : Entity_Id) return Entity_Id is
+ Siz : constant Uint := RM_Size (Base_Type (Typ));
+ Int_Typ : Entity_Id;
+
+ begin
+ -- We need to accommodate unsigned values
+
+ if Siz < 8 then
+ Int_Typ := Standard_Integer_8;
+
+ elsif Siz < 16 then
+ Int_Typ := Standard_Integer_16;
+
+ elsif Siz < 32 then
+ Int_Typ := Standard_Integer_32;
+
+ else
+ Int_Typ := Standard_Integer_64;
+ end if;
+
+ return Int_Typ;
+ end Get_Integer_Type;
+
---------------------------------
-- Rewrite_Attribute_Proc_Call --
---------------------------------
@@ -3146,8 +3176,6 @@ package body Exp_Attr is
when Attribute_Enum_Rep => Enum_Rep : declare
Expr : Node_Id;
- Ityp : Entity_Id;
- Psiz : Uint;
begin
-- Get the expression, which is X for Enum_Type'Enum_Rep (X) or
@@ -3177,22 +3205,7 @@ package body Exp_Attr is
-- the size information.
if Is_Enumeration_Type (Ptyp) then
- Psiz := RM_Size (Base_Type (Ptyp));
-
- if Psiz < 8 then
- Ityp := Standard_Integer_8;
-
- elsif Psiz < 16 then
- Ityp := Standard_Integer_16;
-
- elsif Psiz < 32 then
- Ityp := Standard_Integer_32;
-
- else
- Ityp := Standard_Integer_64;
- end if;
-
- Rewrite (N, OK_Convert_To (Ityp, Expr));
+ Rewrite (N, OK_Convert_To (Get_Integer_Type (Ptyp), Expr));
Convert_To_And_Rewrite (Typ, N);
else
@@ -5159,9 +5172,6 @@ package body Exp_Attr is
-- Pos --
---------
- -- For enumeration types with a standard representation, Pos is handled
- -- by the back end.
-
-- For enumeration types, with a non-standard representation we generate
-- a call to the _Rep_To_Pos function created when the type was frozen.
-- The call has the form:
@@ -5172,17 +5182,21 @@ package body Exp_Attr is
-- Program_Error to be raised if the expression has an invalid
-- representation, and False if range checks are suppressed.
+ -- For enumeration types with a standard representation, Pos can be
+ -- rewritten as a simple conversion with Conversion_OK set.
+
-- For integer types, Pos is equivalent to a simple integer conversion
-- and we rewrite it as such.
when Attribute_Pos => Pos : declare
+ Expr : constant Node_Id := First (Exprs);
Etyp : Entity_Id := Base_Type (Ptyp);
begin
-- Deal with zero/non-zero boolean values
if Is_Boolean_Type (Etyp) then
- Adjust_Condition (First (Exprs));
+ Adjust_Condition (Expr);
Etyp := Standard_Boolean;
Set_Prefix (N, New_Occurrence_Of (Standard_Boolean, Loc));
end if;
@@ -5202,21 +5216,32 @@ package body Exp_Attr is
New_Occurrence_Of (TSS (Etyp, TSS_Rep_To_Pos), Loc),
Parameter_Associations => Exprs)));
- Analyze_And_Resolve (N, Typ);
+ -- Standard enumeration type (replace by conversion)
+
+ -- This is simply a direct conversion from the enumeration type to
+ -- the target integer type, which is treated by the back end as a
+ -- normal integer 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 might
+ -- be an illegal conversion.
- -- Standard enumeration type (do universal integer check)
+ -- However the target type is universal integer in most cases,
+ -- which is a very large type, so we first convert to a small
+ -- signed integer type in order not to lose the size information.
else
- Apply_Universal_Integer_Attribute_Checks (N);
+ Rewrite (N, OK_Convert_To (Get_Integer_Type (Ptyp), Expr));
+ Convert_To_And_Rewrite (Typ, N);
+
end if;
-- Deal with integer types (replace by conversion)
elsif Is_Integer_Type (Etyp) then
- Rewrite (N, Convert_To (Typ, First (Exprs)));
- Analyze_And_Resolve (N, Typ);
+ Rewrite (N, Convert_To (Typ, Expr));
end if;
+ Analyze_And_Resolve (N, Typ);
end Pos;
--------------
@@ -6660,13 +6685,13 @@ package body Exp_Attr is
-- Val --
---------
- -- For enumeration types with a standard representation, Val is handled
- -- by the back end.
-
-- For enumeration types with a non-standard representation we use the
-- _Pos_To_Rep array that was created when the type was frozen, unless
-- the representation is contiguous in which case we use an addition.
+ -- For enumeration types with a standard representation, Val can be
+ -- rewritten as a simple conversion with Conversion_OK set.
+
-- For integer types, Val is equivalent to a simple integer conversion
-- and we rewrite it as such.
@@ -6749,11 +6774,16 @@ package body Exp_Attr is
Right_Opnd =>
Convert_To (Ityp, Expr))));
- -- Suppress checks since the range check was done above
- -- and it guarantees that the addition cannot overflow.
+ -- Standard enumeration type
- Analyze_And_Resolve (N, Typ, Suppress => All_Checks);
+ else
+ Rewrite (N, OK_Convert_To (Typ, Expr));
end if;
+
+ -- Suppress checks since the range check was done above
+ -- and it guarantees that the addition cannot overflow.
+
+ Analyze_And_Resolve (N, Typ, Suppress => All_Checks);
end if;
-- Deal with integer types
--- gcc/ada/exp_ch4.adb
+++ gcc/ada/exp_ch4.adb
@@ -12280,9 +12280,11 @@ package body Exp_Ch4 is
-- Special processing is required if there is a change of
-- representation (from enumeration representation clauses).
- if not Same_Representation (Target_Type, Operand_Type) then
+ if not Same_Representation (Target_Type, Operand_Type)
+ and then not Conversion_OK (N)
+ then
- -- Convert: x(y) to x'val (ytyp'val (y))
+ -- Convert: x(y) to x'val (ytyp'pos (y))
Rewrite (N,
Make_Attribute_Reference (Loc,
--- gcc/ada/sinfo.ads
+++ gcc/ada/sinfo.ads
@@ -1017,8 +1017,8 @@ package Sinfo is
-- A flag set on type conversion nodes to indicate that the conversion
-- is to be considered as being valid, even though it is the case that
-- the conversion is not valid Ada. This is used for attributes Enum_Rep,
- -- Fixed_Value and Integer_Value, for internal conversions done for
- -- fixed-point operations, and for certain conversions for calls to
+ -- Pos, Val, Fixed_Value and Integer_Value, for internal conversions done
+ -- for fixed-point operations, and for certain conversions for calls to
-- initialization procedures. If Conversion_OK is set, then Etype must be
-- set (the analyzer assumes that Etype has been set). For the case of
-- fixed-point operands, it also indicates that the conversion is to be
