From: Eric Botcazou <[email protected]>
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.
Tested on x86_64-pc-linux-gnu, committed on master.
---
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 e1b015aacca..bf9d5e1c7a7 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);
--
2.51.0
