From 1956beb8aa91181d614441e943a76fa7f7d8d51c Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Wed, 6 Jul 2016 12:32:35 +0000 Subject: [PATCH] sem_attr.adb (Analyze_Attribute): Allow any expression of discrete type. 2016-07-06 Bob Duff * sem_attr.adb (Analyze_Attribute): Allow any expression of discrete type. * exp_attr.adb (Expand_N_Attribute_Reference): Change the constant-folding code to correctly handle cases newly allowed by Analyze_Attribute. From-SVN: r238042 --- gcc/ada/ChangeLog | 8 +++++ gcc/ada/exp_attr.adb | 71 ++++++++++++++++++++++++-------------------- gcc/ada/sem_attr.adb | 12 ++------ 3 files changed, 49 insertions(+), 42 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 9ddf035e698..9a16f81a4ba 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,11 @@ +2016-07-06 Bob Duff + + * sem_attr.adb (Analyze_Attribute): Allow any expression of + discrete type. + * exp_attr.adb (Expand_N_Attribute_Reference): Change the + constant-folding code to correctly handle cases newly allowed + by Analyze_Attribute. + 2016-07-05 Eric Botcazou * gcc-interface/decl.c (gnat_to_gnu_entity): Invoke global_bindings_p diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 6c5f3b5e7c5..47cee2b6af2 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -3007,11 +3007,46 @@ package body Exp_Attr is -- Enum_Rep -- -------------- - when Attribute_Enum_Rep => Enum_Rep : + when Attribute_Enum_Rep => Enum_Rep : declare + Expr : Node_Id; begin - -- X'Enum_Rep (Y) expands to + -- Get the expression, which is X for Enum_Type'Enum_Rep (X) + -- or X'Enum_Rep. - -- target-type (Y) + if Is_Non_Empty_List (Exprs) then + Expr := First (Exprs); + else + Expr := Pref; + end if; + + -- If the expression is an enumeration literal, it is + -- replaced by the literal value. + + if Nkind (Expr) in N_Has_Entity + and then Ekind (Entity (Expr)) = E_Enumeration_Literal + then + Rewrite (N, + Make_Integer_Literal (Loc, Enumeration_Rep (Entity (Expr)))); + + -- If this is a renaming of a literal, recover the representation + -- of the original. If it renames an expression there is nothing + -- to fold. + + elsif Nkind (Expr) in N_Has_Entity + and then Ekind (Entity (Expr)) = E_Constant + and then Present (Renamed_Object (Entity (Expr))) + and then Is_Entity_Name (Renamed_Object (Entity (Expr))) + and then Ekind (Entity (Renamed_Object (Entity (Expr)))) = + E_Enumeration_Literal + then + Rewrite (N, + Make_Integer_Literal (Loc, + Enumeration_Rep (Entity (Renamed_Object (Entity (Expr)))))); + + -- If not constant-folded above, Enum_Type'Enum_Rep (X) or + -- X'Enum_Rep expands to + + -- target-type (X) -- This is simply a direct conversion from the enumeration type to -- the target integer type, which is treated by the back end as a @@ -3020,37 +3055,9 @@ package body Exp_Attr is -- make sure that the analyzer does not complain about what otherwise -- might be an illegal conversion. - if Is_Non_Empty_List (Exprs) then - Rewrite (N, - OK_Convert_To (Typ, Relocate_Node (First (Exprs)))); - - -- X'Enum_Rep where X is an enumeration literal is replaced by - -- the literal value. - - elsif Ekind (Entity (Pref)) = E_Enumeration_Literal then - Rewrite (N, - Make_Integer_Literal (Loc, Enumeration_Rep (Entity (Pref)))); - - -- If this is a renaming of a literal, recover the representation - -- of the original. If it renames an expression there is nothing - -- to fold. - - elsif Ekind (Entity (Pref)) = E_Constant - and then Present (Renamed_Object (Entity (Pref))) - and then Is_Entity_Name (Renamed_Object (Entity (Pref))) - and then Ekind (Entity (Renamed_Object (Entity (Pref)))) = - E_Enumeration_Literal - then - Rewrite (N, - Make_Integer_Literal (Loc, - Enumeration_Rep (Entity (Renamed_Object (Entity (Pref)))))); - - -- X'Enum_Rep where X is an object does a direct unchecked conversion - -- of the object value, as described for the type case above. - else Rewrite (N, - OK_Convert_To (Typ, Relocate_Node (Pref))); + OK_Convert_To (Typ, Relocate_Node (Expr))); end if; Set_Etype (N, Typ); diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index d6d850994be..a05ad7e5532 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -3742,16 +3742,8 @@ package body Sem_Attr is Check_E1; Check_Discrete_Type; Resolve (E1, P_Base_Type); - - else - if not Is_Entity_Name (P) - or else (not Is_Object (Entity (P)) - and then Ekind (Entity (P)) /= E_Enumeration_Literal) - then - Error_Attr_P - ("prefix of % attribute must be " & - "discrete type/object or enum literal"); - end if; + elsif not Is_Discrete_Type (Etype (P)) then + Error_Attr_P ("prefix of % attribute must be of discrete type"); end if; Set_Etype (N, Universal_Integer);