https://gcc.gnu.org/g:2c7a70ef2ddc754b9972111ccb200521895681a5
commit r16-4972-g2c7a70ef2ddc754b9972111ccb200521895681a5 Author: Eric Botcazou <[email protected]> Date: Tue Oct 7 22:57:02 2025 +0200 ada: Fix incorrect static string concatenation with null left string It comes from the implementation of an optimization for static concatenation in Resolve_String_Literal, which causes the original subtype of the literal to be lost. Now this subtype must be preserved in the case where the left operand of the concatenation may be null, per the 4.5.3(5) subclause. gcc/ada/ChangeLog: PR ada/122160 * sem_res.adb (Resolve_Op_Concat_Rest): Do not build the subtype of the second operand again if it has already been built. (Resolve_String_Literal): Do not defer the creation of the subtype for the right operand of a concatenation whose left operand may be the null string. Diff: --- gcc/ada/sem_res.adb | 21 +++++++++++++++++---- 1 file changed, 17 insertions(+), 4 deletions(-) diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index e1b015aaccad..bf9d5e1c7a7d 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -10811,7 +10811,12 @@ package body Sem_Res is and then Is_Character_Type (Component_Type (Typ)) then Set_String_Literal_Subtype (Op1, Typ); - Set_String_Literal_Subtype (Op2, Typ); + + -- See Resolve_String_Literal for the asymmetry + + if Ekind (Etype (Op2)) /= E_String_Literal_Subtype then + Set_String_Literal_Subtype (Op2, Typ); + end if; end if; end Resolve_Op_Concat_Rest; @@ -12031,11 +12036,14 @@ package body Sem_Res is begin -- For a string appearing in a concatenation, defer creation of the -- string_literal_subtype until the end of the resolution of the - -- concatenation, because the literal may be constant-folded away. This - -- is a useful optimization for long concatenation expressions. + -- concatenation, because the literal may be constant-folded away. + -- This is a useful optimization for long concatenation expressions, + -- but it cannot be done if the string is the right operand and the + -- left operand may be null, because 4.5.3(5) says that the result is + -- the right operand and, in particular, has its original subtype. -- If the string is an aggregate built for a single character (which - -- happens in a non-static context) or a is null string to which special + -- happens in a non-static context) or is a null string to which special -- checks may apply, we build the subtype. Wide strings must also get a -- string subtype if they come from a one character aggregate. Strings -- generated by attributes might be static, but it is often hard to @@ -12048,6 +12056,11 @@ package body Sem_Res is or else Nkind (Parent (N)) /= N_Op_Concat or else (N /= Left_Opnd (Parent (N)) and then N /= Right_Opnd (Parent (N))) + or else (N = Right_Opnd (Parent (N)) + and then + (Nkind (Left_Opnd (Parent (N))) /= N_String_Literal + or else + String_Length (Strval (Left_Opnd (Parent (N)))) = 0)) or else ((Typ = Standard_Wide_String or else Typ = Standard_Wide_Wide_String) and then Nkind (Original_Node (N)) /= N_String_Literal);
