diff options
author | Robert Dewar <dewar@adacore.com> | 2015-01-06 09:35:30 +0000 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2015-01-06 10:35:30 +0100 |
commit | 4199e8c6fbc5ac6de95d50181c0b6083d0b6f0ad (patch) | |
tree | 5bbdc978b5e3b9ed007d520238f1affbb5739c20 /gcc | |
parent | db761fee4caf7ceb652dc6224428a675de7b1cb3 (diff) | |
download | gcc-4199e8c6fbc5ac6de95d50181c0b6083d0b6f0ad.zip gcc-4199e8c6fbc5ac6de95d50181c0b6083d0b6f0ad.tar.gz gcc-4199e8c6fbc5ac6de95d50181c0b6083d0b6f0ad.tar.bz2 |
exp_attr.adb (Expand_N_Attribute_Reference): Add dummy entry for Enum_Image.
2015-01-06 Robert Dewar <dewar@adacore.com>
* exp_attr.adb (Expand_N_Attribute_Reference): Add dummy entry
for Enum_Image.
* sem_attr.adb: Implement Enum_Image attribute.
* snames.ads-tmpl: Add entries for Enum_Image attribute.
From-SVN: r219236
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/ada/ChangeLog | 7 | ||||
-rw-r--r-- | gcc/ada/exp_attr.adb | 5 | ||||
-rw-r--r-- | gcc/ada/sem_attr.adb | 82 | ||||
-rw-r--r-- | gcc/ada/snames.ads-tmpl | 2 |
4 files changed, 76 insertions, 20 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index a64555e..16bb768e 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,12 @@ 2015-01-06 Robert Dewar <dewar@adacore.com> + * exp_attr.adb (Expand_N_Attribute_Reference): Add dummy entry + for Enum_Image. + * sem_attr.adb: Implement Enum_Image attribute. + * snames.ads-tmpl: Add entries for Enum_Image attribute. + +2015-01-06 Robert Dewar <dewar@adacore.com> + * namet.ads: Document use of Boolean2 for No_Use_Of_Entity. * restrict.ads (No_Use_Of_Entity): New table. * sem_prag.adb (Process_Restrictions_Or_Restriction_Warnings): diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 663507a..5a66e3f 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -3497,9 +3497,9 @@ package body Exp_Attr is begin Rewrite (N, Make_Attribute_Reference (Loc, - Prefix => New_Occurrence_Of (Ptyp, Loc), + Prefix => New_Occurrence_Of (Ptyp, Loc), Attribute_Name => Name_Image, - Expressions => New_List (Relocate_Node (Pref)))); + Expressions => New_List (Relocate_Node (Pref)))); Analyze_And_Resolve (N, Standard_String); end Img; @@ -7178,6 +7178,7 @@ package body Exp_Attr is Attribute_Digits | Attribute_Emax | Attribute_Enabled | + Attribute_Enum_Image | Attribute_Epsilon | Attribute_Fast_Math | Attribute_First_Valid | diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 7ff7939..1fcda36 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -288,13 +288,13 @@ package body Sem_Attr is -- Check that two attribute arguments are present procedure Check_Enum_Image; - -- If the prefix type is an enumeration type, set all its literals - -- as referenced, since the image function could possibly end up - -- referencing any of the literals indirectly. Same for Enum_Val. + -- If the prefix type of 'Image is an enumeration type, set all its + -- literals as referenced, since the image function could possibly end + -- up referencing any of the literals indirectly. Same for Enum_Val. -- Set the flag only if the reference is in the main code unit. Same -- restriction when resolving 'Value; otherwise an improperly set - -- reference when analyzing an inlined body will lose a proper warning - -- on a useless with_clause. + -- reference when analyzing an inlined body will lose a proper + -- warning on a useless with_clause. procedure Check_First_Last_Valid; -- Perform all checks for First_Valid and Last_Valid attributes @@ -2455,7 +2455,7 @@ package body Sem_Attr is then Error_Msg_N ("in a constraint the current instance can only" - & " be used with an access attribute", N); + & " be used with an access attribute", N); end if; end if; end; @@ -3378,6 +3378,31 @@ package body Sem_Attr is Set_Etype (N, Standard_Boolean); + ---------------- + -- Enum_Image -- + ---------------- + + when Attribute_Enum_Image => Enum_Image : + begin + Check_SPARK_05_Restriction_On_Attribute; + Check_Scalar_Type; + Set_Etype (N, Standard_String); + + if not Is_Enumeration_Type (P_Type) then + Error_Msg_Name_1 := Aname; + Error_Msg_N + ("% attribute only allowed for enumerated types", N); + end if; + + Check_E1; + Resolve (E1, P_Base_Type); + + if not Is_OK_Static_Expression (E1) then + Error_Msg_Name_1 := Aname; + Error_Msg_N ("% attribute requires static argument", E1); + end if; + end Enum_Image; + -------------- -- Enum_Rep -- -------------- @@ -7714,21 +7739,21 @@ package body Sem_Attr is case Id is - -- Attributes related to Ada 2012 iterators (placeholder ???) + -- Attributes related to Ada 2012 iterators (placeholder ???) - when Attribute_Constant_Indexing | - Attribute_Default_Iterator | - Attribute_Implicit_Dereference | - Attribute_Iterator_Element | - Attribute_Iterable | - Attribute_Variable_Indexing => null; + when Attribute_Constant_Indexing | + Attribute_Default_Iterator | + Attribute_Implicit_Dereference | + Attribute_Iterator_Element | + Attribute_Iterable | + Attribute_Variable_Indexing => null; - -- Internal attributes used to deal with Ada 2012 delayed aspects. - -- These were already rejected by the parser. Thus they shouldn't - -- appear here. + -- Internal attributes used to deal with Ada 2012 delayed aspects. + -- These were already rejected by the parser. Thus they shouldn't + -- appear here. - when Internal_Attribute_Id => - raise Program_Error; + when Internal_Attribute_Id => + raise Program_Error; -------------- -- Adjacent -- @@ -7910,6 +7935,27 @@ package body Sem_Attr is Fold_Uint (N, 4 * Mantissa, Static); + ---------------- + -- Enum_Image -- + ---------------- + + -- Enum_Image is always static and always has a string literal result + + when Attribute_Enum_Image => + declare + Lit : constant Entity_Id := Entity (E1); + Str : String_Id; + begin + Start_String; + Get_Unqualified_Decoded_Name_String (Chars (Lit)); + Set_Casing (All_Upper_Case); + Store_String_Chars (Name_Buffer (1 .. Name_Len)); + Str := End_String; + Rewrite (N, Make_String_Literal (Loc, Strval => Str)); + Analyze_And_Resolve (N, Standard_String); + Set_Is_Static_Expression (N, True); + end; + -------------- -- Enum_Rep -- -------------- diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index 673a753..73b1e36 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -962,6 +962,7 @@ package Snames is Name_Adjacent : constant Name_Id := N + $; Name_Ceiling : constant Name_Id := N + $; Name_Copy_Sign : constant Name_Id := N + $; + Name_Enum_Image : constant Name_Id := N + $; Name_Floor : constant Name_Id := N + $; Name_Fraction : constant Name_Id := N + $; Name_From_Any : constant Name_Id := N + $; -- GNAT @@ -1589,6 +1590,7 @@ package Snames is Attribute_Adjacent, Attribute_Ceiling, Attribute_Copy_Sign, + Attribute_Enum_Image, Attribute_Floor, Attribute_Fraction, Attribute_From_Any, |