[gcc r15-668] ada: Fix static 'Img for enumeration type with Discard_Names

[Marc Poulhi?s via Gcc-cvs]

https://gcc.gnu.org/g:9edbaab0f6eb83351ef65e5bc0e427a415e04915

commit r15-668-g9edbaab0f6eb83351ef65e5bc0e427a415e04915
Author: Piotr Trojanek <troja...@adacore.com>
Date:   Fri Mar 22 14:50:15 2024 +0100

    ada: Fix static 'Img for enumeration type with Discard_Names
    
    Fix a short-circuit folding of 'Img for enumeration type, which wrongly
    ignored Discard_Names and exposed enumeration literals.
    
    gcc/ada/
    
            * sem_attr.adb (Eval_Attribute): Handle enumeration type with
            Discard_Names.

Diff:
---
 gcc/ada/sem_attr.adb | 19 ++++++++++++++++---
 1 file changed, 16 insertions(+), 3 deletions(-)

diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 96f216cc587d..2b22cf13ad00 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -8221,13 +8221,26 @@ package body Sem_Attr is
       then
          declare
             Lit : constant Entity_Id := Expr_Value_E (P);
+            Typ : constant Entity_Id := Etype (Entity (P));
             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));
+
+            --  If Discard_Names is in effect for the type, then we emit the
+            --  numeric representation of the prefix literal 'Pos attribute,
+            --  prefixed with a single space.
+
+            if Discard_Names (Typ) then
+               UI_Image (Enumeration_Pos (Lit), Decimal);
+               Store_String_Char  (' ');
+               Store_String_Chars (UI_Image_Buffer (1 .. UI_Image_Length));
+            else
+               Get_Unqualified_Decoded_Name_String (Chars (Lit));
+               Set_Casing (All_Upper_Case);
+               Store_String_Chars (Name_Buffer (1 .. Name_Len));
+            end if;
+
             Str := End_String;
 
             Rewrite (N, Make_String_Literal (Loc, Strval => Str));