https://gcc.gnu.org/g:4c0a478aa889522e9b6be889fbcefe8ba649194f
commit r16-8890-g4c0a478aa889522e9b6be889fbcefe8ba649194f Author: Eric Botcazou <[email protected]> Date: Sun May 10 12:51:44 2026 +0200 Ada: Fix Image for derived enumeration type with representation clause The problem is that Expand_Image_Attribute incorrectly fetches the root type for enumeration types, thus bypassing a clause present on the derived type. The fix is to change the two fields Lit_Indexes and Lit_Strings defined for enumeration types and subtypes to be formally present on root types only, as well as to make Expand_Image_Attribute stick to base types. gcc/ada/ PR ada/125240 * gen_il-gen-gen_entities.adb (Enumeration_Kind): Make Lit_Indexes and Lit_Strings be defined for root types only. * einfo.ads (Lit_Hash): Adjust description. (Lit_Indexes): Likewise. (Lit_Strings): Likewise. (E_Enumeration_Type): Likewise. * exp_imgv.adb (Expand_Image_Attribute): Do not fetch the root type for enumeration types, except for character types, and adjust. gcc/testsuite/ * gnat.dg/enum6.adb: New test. Diff: --- gcc/ada/einfo.ads | 17 ++++++--------- gcc/ada/exp_imgv.adb | 9 ++++---- gcc/ada/gen_il-gen-gen_entities.adb | 8 +++---- gcc/testsuite/gnat.dg/enum6.adb | 43 +++++++++++++++++++++++++++++++++++++ 4 files changed, 58 insertions(+), 19 deletions(-) diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 9e716c427ab8..c908542e3e7c 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -3647,22 +3647,19 @@ package Einfo is -- type of the object. -- Lit_Hash [root type only] --- Defined in enumeration types and subtypes. Non-empty only for the --- case of an enumeration root type, where it contains the entity for +-- Defined in enumeration types and subtypes. Contains the entity for -- the generated hash function. See unit Exp_Imgv for full details of -- the nature and use of this entity for implementing the Value -- attribute for the enumeration type in question. --- Lit_Indexes --- Defined in enumeration types and subtypes. Non-empty only for the --- case of an enumeration root type, where it contains the entity for +-- Lit_Indexes [root type only] +-- Defined in enumeration types and subtypes. Contains the entity for -- the generated indexes entity. See unit Exp_Imgv for full details of -- the nature and use of this entity for implementing the Image and -- Value attributes for the enumeration type in question. --- Lit_Strings --- Defined in enumeration types and subtypes. Non-empty only for the --- case of an enumeration root type, where it contains the entity for +-- Lit_Strings [root type only] +-- Defined in enumeration types and subtypes. Contains the entity for -- the literals string entity. See unit Exp_Imgv for full details of -- the nature and use of this entity for implementing the Image and -- Value attributes for the enumeration type in question. @@ -5530,12 +5527,12 @@ package Einfo is -- E_Enumeration_Subtype -- First_Entity $$$ type -- Renamed_Object $$$ - -- Lit_Strings (root type only) -- First_Literal + -- Lit_Hash (root type only) -- Lit_Indexes (root type only) + -- Lit_Strings (root type only) -- Default_Aspect_Value (base type only) -- Scalar_Range - -- Lit_Hash (root type only) -- Enum_Pos_To_Rep (type only) -- Static_Discrete_Predicate -- Has_Biased_Representation diff --git a/gcc/ada/exp_imgv.adb b/gcc/ada/exp_imgv.adb index 469c7c065da7..082acbe4d88a 100644 --- a/gcc/ada/exp_imgv.adb +++ b/gcc/ada/exp_imgv.adb @@ -1061,11 +1061,10 @@ package body Exp_Imgv is -- Ada 2022 allows 'Image on private types, so fetch the underlying -- type to obtain the structure of the type. We use the base type, - -- not the root type for discrete types, to handle properly derived - -- types, but we use the root type for enumeration types, because the - -- literal map is attached to the root. Should be inherited ??? + -- not the root type, for discrete types in order to handle derived + -- types, except for character types for which this is not needed. - if Is_Real_Type (Ptyp) or else Is_Enumeration_Type (Ptyp) then + if Is_Real_Type (Ptyp) or else Is_Character_Type (Ptyp) then Rtyp := Underlying_Type (Root_Type (Ptyp)); else Rtyp := Underlying_Type (Base_Type (Ptyp)); @@ -1076,7 +1075,7 @@ package body Exp_Imgv is Enum_Case := False; - if Rtyp = Standard_Boolean then + if Is_Boolean_Type (Rtyp) then -- Use inline expansion if the -gnatd_x switch is not passed to the -- compiler. Otherwise expand into a call to the runtime. diff --git a/gcc/ada/gen_il-gen-gen_entities.adb b/gcc/ada/gen_il-gen-gen_entities.adb index 94a1f04a613a..bb1dd7a94416 100644 --- a/gcc/ada/gen_il-gen-gen_entities.adb +++ b/gcc/ada/gen_il-gen-gen_entities.adb @@ -551,11 +551,11 @@ begin -- Gen_IL.Gen.Gen_Entities (Sm (First_Literal, Node_Id), Sm (Has_Enumeration_Rep_Clause, Flag), Sm (Has_Pragma_Ordered, Flag, Impl_Base_Type_Only), - Sm (Lit_Indexes, Node_Id), - Sm (Lit_Strings, Node_Id), + Sm (Lit_Hash, Node_Id, Root_Type_Only), + Sm (Lit_Indexes, Node_Id, Root_Type_Only), + Sm (Lit_Strings, Node_Id, Root_Type_Only), Sm (Nonzero_Is_True, Flag, Base_Type_Only, - Pre => "Root_Type (N) = Standard_Boolean"), - Sm (Lit_Hash, Node_Id, Root_Type_Only))); + Pre => "Root_Type (N) = Standard_Boolean"))); Cc (E_Enumeration_Type, Enumeration_Kind, -- Enumeration types, created by an enumeration type declaration diff --git a/gcc/testsuite/gnat.dg/enum6.adb b/gcc/testsuite/gnat.dg/enum6.adb new file mode 100644 index 000000000000..064a3f66d85a --- /dev/null +++ b/gcc/testsuite/gnat.dg/enum6.adb @@ -0,0 +1,43 @@ +-- { dg-do run } + +procedure Enum6 is + + type Base_Enum is (Ten, Twenty); + + type Derived_Enum is new Base_Enum; + for Derived_Enum use (Ten => 10, Twenty => 20); + + type Rep_Enum is (Ten, Twenty); + for Rep_Enum use (Ten => 10, Twenty => 20); + + OK : Boolean := True; + +begin + for E in Base_Enum loop + if (E = Ten and then Base_Enum'Image(E) /= "TEN") + or else (E = Twenty and then Base_Enum'Image(E) /= "TWENTY") + then + OK := False; + end if; + end loop; + + for E in Derived_Enum loop + if (E = Ten and then Derived_Enum'Image(E) /= "TEN") + or else (E = Twenty and then Derived_Enum'Image(E) /= "TWENTY") + then + OK := False; + end if; + end loop; + + for E in Rep_Enum loop + if (E = Ten and then Rep_Enum'Image(E) /= "TEN") + or else (E = Twenty and then Rep_Enum'Image(E) /= "TWENTY") + then + OK := False; + end if; + end loop; + + if not OK then + raise Program_Error; + end if; +end;
