diff options
Diffstat (limited to 'gcc/ada/sem_res.adb')
| -rw-r--r-- | gcc/ada/sem_res.adb | 28 |
1 files changed, 20 insertions, 8 deletions
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 4d46755..bf9d5e1 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -262,9 +262,8 @@ package body Sem_Res is function Operator_Kind (Op_Name : Name_Id; - Is_Binary : Boolean) return Node_Kind; - -- Utility to map the name of an operator into the corresponding Node. Used - -- by other node rewriting procedures. + Is_Binary : Boolean) return N_Op; + -- Map the name of an operator into the corresponding Node_Kind procedure Resolve_Actuals (N : Node_Id; Nam : Entity_Id); -- Resolve actuals of call, and add default expressions for missing ones. @@ -1986,7 +1985,7 @@ package body Sem_Res is function Operator_Kind (Op_Name : Name_Id; - Is_Binary : Boolean) return Node_Kind + Is_Binary : Boolean) return N_Op is Kind : Node_Kind; @@ -10812,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; @@ -12032,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 @@ -12049,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); |