Skip to content

R
riscv-gcc-1
Commit 4199e8c6 by Robert Dewar Committed by Arnaud Charlet
Options

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
parent db761fee
Showing with 76 additions and 20 deletions
gcc/ada/ChangeLog
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):
......
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 |
......
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 --
--------------
......
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,
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment