From: Bob Duff <d...@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(-) diff --git a/gcc/ada/exp_imgv.adb b/gcc/ada/exp_imgv.adb index 257f65badd0..a31ce1d8c8f 100644 --- a/gcc/ada/exp_imgv.adb +++ b/gcc/ada/exp_imgv.adb @@ -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; diff --git a/gcc/ada/exp_put_image.adb b/gcc/ada/exp_put_image.adb index c194237aa20..9eda3231c6b 100644 --- a/gcc/ada/exp_put_image.adb +++ b/gcc/ada/exp_put_image.adb @@ -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 diff --git a/gcc/ada/par-ch4.adb b/gcc/ada/par-ch4.adb index 2505eb629ab..52f2b02361a 100644 --- a/gcc/ada/par-ch4.adb +++ b/gcc/ada/par-ch4.adb @@ -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 diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 39103279fa7..8257d4b3536 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -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 | diff --git a/gcc/ada/sem_attr.ads b/gcc/ada/sem_attr.ads index b7a05713ed1..f383ab50000 100644 --- a/gcc/ada/sem_attr.ads +++ b/gcc/ada/sem_attr.ads @@ -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 -- diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index 9868d97b740..9d17b43802e 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -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 ------------------------------------ -- 2.40.0