@@ -762,7 +762,7 @@ package body Exp_Imgv is
-- Snn (1 .. Pnn) then occurs as in the other cases. A special case is
-- when pragma Discard_Names applies, in which case we replace expr by:
- -- (rt'Pos (expr))'Img
+ -- (rt'Pos (expr))'Image
-- So that the result is a space followed by the decimal value for the
-- position of the enumeration value in the enumeration type.
@@ -1211,8 +1211,8 @@ package body Exp_Imgv is
or else No (Lit_Strings (Rtyp))
then
-- When pragma Discard_Names applies to the first subtype, build
- -- (Long_Long_Integer (Pref'Pos (Expr)))'Img. The conversion is
- -- there to avoid applying 'Img directly in Universal_Integer,
+ -- (Long_Long_Integer (Pref'Pos (Expr)))'Image. The conversion is
+ -- there to avoid applying 'Image directly in Universal_Integer,
-- which can be a very large type. See also the handling of 'Val.
Rewrite (N,
@@ -1223,8 +1223,7 @@ package body Exp_Imgv is
Prefix => Pref,
Attribute_Name => Name_Pos,
Expressions => New_List (Expr))),
- Attribute_Name =>
- Name_Img));
+ Attribute_Name => Name_Image));
Analyze_And_Resolve (N, Standard_String);
return;
@@ -1126,7 +1126,9 @@ package body Exp_Put_Image is
-- Attribute names that will be mapped to the corresponding result types
-- and functions.
- Attribute_Name_Id : constant Name_Id := Attribute_Name (N);
+ Attribute_Name_Id : constant Name_Id :=
+ (if Attribute_Name (N) = Name_Img then Name_Image
+ else Attribute_Name (N));
Result_Typ : constant Entity_Id :=
(case Image_Name_Id'(Attribute_Name_Id) is
@@ -34,17 +34,17 @@ package body Ch4 is
-- Attributes that cannot have arguments
- Is_Parameterless_Attribute : constant Attribute_Class_Array :=
- (Attribute_Base => True,
- Attribute_Body_Version => True,
- Attribute_Class => True,
- Attribute_External_Tag => True,
- Attribute_Img => True,
- Attribute_Loop_Entry => True,
- Attribute_Old => True,
- Attribute_Result => True,
- Attribute_Stub_Type => True,
- Attribute_Version => True,
+ Is_Parameterless_Attribute : constant Attribute_Set :=
+ (Attribute_Base |
+ Attribute_Body_Version |
+ Attribute_Class |
+ Attribute_External_Tag |
+ Attribute_Img |
+ Attribute_Loop_Entry |
+ Attribute_Old |
+ Attribute_Result |
+ Attribute_Stub_Type |
+ Attribute_Version |
Attribute_Type_Key => True,
others => False);
-- This map contains True for parameterless attributes that return a string
@@ -104,8 +104,8 @@ package body Sem_Attr is
-- In Ada 83 mode, these are the only recognized attributes. In other Ada
-- modes all these attributes are recognized, even if removed in Ada 95.
- Attribute_83 : constant Attribute_Class_Array := Attribute_Class_Array'(
- Attribute_Address |
+ Attribute_83 : constant Attribute_Set :=
+ (Attribute_Address |
Attribute_Aft |
Attribute_Alignment |
Attribute_Base |
@@ -153,8 +153,8 @@ package body Sem_Attr is
-- RM which are not defined in Ada 95. These are recognized in Ada 95 mode,
-- but in Ada 95 they are considered to be implementation defined.
- Attribute_05 : constant Attribute_Class_Array := Attribute_Class_Array'(
- Attribute_Machine_Rounding |
+ Attribute_05 : constant Attribute_Set :=
+ (Attribute_Machine_Rounding |
Attribute_Mod |
Attribute_Priority |
Attribute_Stream_Size |
@@ -165,8 +165,8 @@ package body Sem_Attr is
-- RM which are not defined in Ada 2005. These are recognized in Ada 95
-- and Ada 2005 modes, but are considered to be implementation defined.
- Attribute_12 : constant Attribute_Class_Array := Attribute_Class_Array'(
- Attribute_First_Valid |
+ Attribute_12 : constant Attribute_Set :=
+ (Attribute_First_Valid |
Attribute_Has_Same_Storage |
Attribute_Last_Valid |
Attribute_Max_Alignment_For_Allocation => True,
@@ -176,10 +176,10 @@ package body Sem_Attr is
-- RM which are not defined in Ada 2012. These are recognized in Ada
-- 95/2005/2012 modes, but are considered to be implementation defined.
- Attribute_22 : constant Attribute_Class_Array := Attribute_Class_Array'(
- Attribute_Enum_Rep |
- Attribute_Enum_Val => True,
- Attribute_Index => True,
+ Attribute_22 : constant Attribute_Set :=
+ (Attribute_Enum_Rep |
+ Attribute_Enum_Val |
+ Attribute_Index |
Attribute_Preelaborable_Initialization => True,
others => False);
@@ -187,9 +187,8 @@ package body Sem_Attr is
-- of their prefixes or result in an access value. Such prefixes can be
-- considered as lvalues.
- Attribute_Name_Implies_Lvalue_Prefix : constant Attribute_Class_Array :=
- Attribute_Class_Array'(
- Attribute_Access |
+ Attribute_Name_Implies_Lvalue_Prefix : constant Attribute_Set :=
+ (Attribute_Access |
Attribute_Address |
Attribute_Input |
Attribute_Read |
@@ -46,8 +46,8 @@ package Sem_Attr is
-- in GNAT, as well as constructing an array of flags indicating which
-- attributes these are.
- Attribute_Impl_Def : constant Attribute_Class_Array :=
- Attribute_Class_Array'(
+ Attribute_Impl_Def : constant Attribute_Set :=
+ (
------------------
-- Abort_Signal --
@@ -1643,7 +1643,7 @@ package Snames is
subtype Internal_Attribute_Id is Attribute_Id
range Attribute_CPU .. Attribute_Interrupt_Priority;
- type Attribute_Class_Array is array (Attribute_Id) of Boolean;
+ type Attribute_Set is array (Attribute_Id) of Boolean;
-- Type used to build attribute classification flag arrays
------------------------------------
From: Bob Duff <duff@adacore.com> 'Image is allowed as an actual for a generic formal function. This patch fixes a crash when 'Img is used instead of 'Image in that context. Misc cleanups. gcc/ada/ * exp_put_image.adb (Build_Image_Call): Treat 'Img the same as 'Image. * exp_imgv.adb (Expand_Image_Attribute): If Discard_Names, expand to 'Image instead of 'Img. * snames.ads-tmpl, par-ch4.adb, sem_attr.adb, sem_attr.ads: Cleanups: Rename Attribute_Class_Array to be Attribute_Set. Remove unnecessary qualifications. DRY: Don't repeat "True". Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_imgv.adb | 9 ++++----- gcc/ada/exp_put_image.adb | 4 +++- gcc/ada/par-ch4.adb | 22 +++++++++++----------- gcc/ada/sem_attr.adb | 25 ++++++++++++------------- gcc/ada/sem_attr.ads | 4 ++-- gcc/ada/snames.ads-tmpl | 2 +- 6 files changed, 33 insertions(+), 33 deletions(-)