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 --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index e1b015aaccad1d75068c581eff63ebdfc75d98cb..bf9d5e1c7a7d5f252d1706d62f6447846c9c3e6e 100644 (file)
--- 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);