ada: Reject ambiguous function calls in interpolated string expressions

This patch enhances support for this language feature by rejecting
more ambiguous function calls. In terms of name resolution, the
analysis of interpolated expressions is now treated as an expression
of any type, as required by the documentation. Additionally, support
for nested interpolated strings has been removed.

gcc/ada/

	* gen_il-fields.ads (Is_Interpolated_String_Literal): New field.
	* gen_il-gen-gen_nodes.adb (Is_Interpolated_String_Literal): The
	new field is a flag handled by the parser (syntax flag).
	* par-ch2.adb (P_Interpolated_String_Literal): Decorate the new
	flag.
	* sem_ch2.adb (Analyze_Interpolated_String_Literal): Improve code
	detecting and reporting ambiguous function calls.
	* sem_res.adb (Resolve_Interpolated_String_Literal): Restrict
	resolution imposed by the context type to string literals that
	have the new flag.
	* sinfo.ads (Is_Interpolated_String_Literal): New field defined in
	string literals. Fix documentation of the syntax rule of
	interpolated string literal.

6 files changed, 213 insertions, 55 deletions

diff --git a/gcc/ada/gen_il-fields.ads b/gcc/ada/gen_il-fields.ads
index 520ea55..9b85401 100644
--- a/gcc/ada/gen_il-fields.ads
+++ b/gcc/ada/gen_il-fields.ads
@@ -263,6 +263,7 @@ package Gen_IL.Fields is
       Is_In_Discriminant_Check,
       Is_Inherited_Pragma,
       Is_Initialization_Block,
+      Is_Interpolated_String_Literal,
       Is_Known_Guaranteed_ABE,
       Is_Machine_Number,
       Is_Null_Loop,
diff --git a/gcc/ada/gen_il-gen-gen_nodes.adb b/gcc/ada/gen_il-gen-gen_nodes.adb
index b1ca6cf..7224556 100644
--- a/gcc/ada/gen_il-gen-gen_nodes.adb
+++ b/gcc/ada/gen_il-gen-gen_nodes.adb
@@ -444,6 +444,7 @@ begin -- Gen_IL.Gen.Gen_Nodes
    Cc (N_String_Literal, N_Numeric_Or_String_Literal,
        (Sy (Strval, String_Id),
         Sy (Is_Folded_In_Parser, Flag),
+        Sy (Is_Interpolated_String_Literal, Flag),
         Sm (Has_Wide_Character, Flag),
         Sm (Has_Wide_Wide_Character, Flag)));
 
diff --git a/gcc/ada/par-ch2.adb b/gcc/ada/par-ch2.adb
index f249ae7..9823234 100644
--- a/gcc/ada/par-ch2.adb
+++ b/gcc/ada/par-ch2.adb
@@ -237,6 +237,7 @@ package body Ch2 is
          Error_Msg_SC ("string literal expected");
 
       else
+         Set_Is_Interpolated_String_Literal (Token_Node);
          Append_To (Elements_List, Token_Node);
          Scan;  --  past string_literal
 
@@ -261,6 +262,7 @@ package body Ch2 is
                   Error_Msg_SC ("unexpected string literal");
                end if;
 
+               Set_Is_Interpolated_String_Literal (Token_Node);
                Append_To (Elements_List, Token_Node);
                Scan; --  past string_literal
             end if;
diff --git a/gcc/ada/sem_ch2.adb b/gcc/ada/sem_ch2.adb
index ddbb329..6d11b71 100644
--- a/gcc/ada/sem_ch2.adb
+++ b/gcc/ada/sem_ch2.adb
@@ -138,67 +138,113 @@ package body Sem_Ch2 is
 
    procedure Analyze_Interpolated_String_Literal (N : Node_Id) is
 
-      procedure Check_Ambiguous_Parameterless_Call (Func_Call : Node_Id);
-      --  Examine the interpretations of the call to the given parameterless
-      --  function call and report the location of each interpretation.
+      procedure Check_Ambiguous_Call (Func_Call : Node_Id);
+      --  Examine the interpretations of the call to the given function call
+      --  and report the location of each interpretation.
 
-      ----------------------------------------
-      -- Check_Ambiguous_Parameterless_Call --
-      ----------------------------------------
+      --------------------------
+      -- Check_Ambiguous_Call --
+      --------------------------
 
-      procedure Check_Ambiguous_Parameterless_Call (Func_Call : Node_Id) is
+      procedure Check_Ambiguous_Call (Func_Call : Node_Id) is
 
-         procedure Report_Interpretation (E : Entity_Id);
-         --  Report an interpretation of the function call
+         procedure Report_Interpretation (Nam : Entity_Id; Typ : Entity_Id);
+         --  Report an interpretation of the function call. When calling a
+         --  standard operator, use the location of the type, which may be
+         --  user-defined.
 
          ---------------------------
          -- Report_Interpretation --
          ---------------------------
 
-         procedure Report_Interpretation (E : Entity_Id) is
+         procedure Report_Interpretation (Nam : Entity_Id; Typ : Entity_Id) is
          begin
-            Error_Msg_Sloc := Sloc (E);
+            if Sloc (Nam) = Standard_Location then
+               Error_Msg_Sloc := Sloc (Typ);
+            else
+               Error_Msg_Sloc := Sloc (Nam);
+            end if;
 
-            if Nkind (Parent (E)) = N_Full_Type_Declaration then
-               Error_Msg_N ("interpretation (inherited) #!", Func_Call);
+            if Nkind (Parent (Nam)) = N_Full_Type_Declaration then
+               Error_Msg_N
+                 ("\\possible interpretation (inherited)#!", Func_Call);
             else
-               Error_Msg_N ("interpretation #!", Func_Call);
+               Error_Msg_N ("\\possible interpretation#!", Func_Call);
             end if;
          end Report_Interpretation;
 
-         --  Local variables
-
-         Error_Reported : Boolean;
-         I              : Interp_Index;
-         It             : Interp;
-
-      --  Start of processing for Check_Ambiguous_Parameterless_Call
+      --  Start of processing for Check_Ambiguous_Call
 
       begin
-         Error_Reported := False;
-
-         --  Examine possible interpretations
-
-         Get_First_Interp (Name (Func_Call), I, It);
-         while Present (It.Nam) loop
-            if It.Nam /= Entity (Name (Func_Call))
-              and then Ekind (It.Nam) = E_Function
-              and then No (First_Formal (It.Nam))
-            then
-               if not Error_Reported then
-                  Error_Msg_NE
-                    ("ambiguous call to&", Func_Call,
-                     Entity (Name (Func_Call)));
-                  Report_Interpretation (Entity (Name (Func_Call)));
-                  Error_Reported := True;
+         Check_Parameterless_Call (Func_Call);
+
+         if Is_Overloaded (Func_Call) then
+            declare
+               I   : Interp_Index;
+               I1  : Interp_Index;
+               It  : Interp;
+               It1 : Interp;
+               N1  : Entity_Id;
+               T1  : Entity_Id;
+
+            begin
+               --  Remove procedure calls, as they cannot syntactically appear
+               --  in interpolated expressions. These calls were not removed by
+               --  type checking because interpolated expressions do not impose
+               --  a context type.
+
+               Get_First_Interp (Func_Call, I, It);
+               while Present (It.Nam) loop
+                  if It.Typ = Standard_Void_Type then
+                     Remove_Interp (I);
+                  end if;
+
+                  Get_Next_Interp (I, It);
+               end loop;
+
+               Get_First_Interp (Func_Call, I, It);
+
+               if No (It.Nam) then
+                  Error_Msg_N ("illegal expression", Func_Call);
+                  return;
                end if;
 
-               Report_Interpretation (It.Nam);
-            end if;
+               I1  := I;
+               It1 := It;
+
+               --  The node may be labeled overloaded, but still contain only
+               --  one interpretation because others were discarded earlier. If
+               --  this is the case, retain the single interpretation.
+
+               Get_Next_Interp (I, It);
+
+               if Present (It.Typ) then
+                  N1  := It1.Nam;
+                  T1  := It1.Typ;
 
-            Get_Next_Interp (I, It);
-         end loop;
-      end Check_Ambiguous_Parameterless_Call;
+                  It1 := Disambiguate
+                           (N   => Func_Call,
+                            I1  => I1,
+                            I2  => I,
+                            Typ => Any_Type);
+
+                  if It1 = No_Interp then
+                     Error_Msg_NE ("ambiguous call to&", Func_Call,
+                       Entity (Name (Func_Call)));
+
+                     --  Report the first two interpretations
+
+                     Report_Interpretation (It.Nam, It.Typ);
+                     Report_Interpretation (N1, T1);
+
+                     return;
+                  end if;
+               end if;
+
+               Set_Etype (Func_Call, It1.Typ);
+            end;
+         end if;
+      end Check_Ambiguous_Call;
 
       --  Local variables
 
@@ -211,22 +257,114 @@ package body Sem_Ch2 is
 
       Str_Elem := First (Expressions (N));
       while Present (Str_Elem) loop
+         Analyze (Str_Elem);
 
-         --  Before analyzed, a function call that has parameter is an
-         --  N_Indexed_Component node, and a call to a function that has
-         --  no parameters is an N_Identifier node.
+         --  The parser has split the contents of the interpolated string
+         --  into its components. For example, f"before {expr} after" is
+         --  stored in the list of expressions of N as follows:
+         --     first = "before " (is_interpolated_string_literal)
+         --      next =  expr
+         --      next = " after"  (is_interpolated_string_literal)
+         --
+         --  No further action is needed for string literals with the
+         --  attribute Is_Interpolated_String_Literal set, as they are
+         --  components of the interpolated string literal. The type of
+         --  these components will be determined by the context when
+         --  resolved (see Expand_N_Interpolated_String_Literal). The
+         --  rest of the components in the list of expressions of N are
+         --  the root nodes of the interpolated expressions.
+
+         if Nkind (Str_Elem) = N_String_Literal
+           and then Is_Interpolated_String_Literal (Str_Elem)
+         then
+            null;
 
-         Analyze (Str_Elem);
+         elsif Nkind (Str_Elem) = N_Function_Call then
+            Check_Ambiguous_Call (Str_Elem);
 
-         --  After analyzed, if it is still an N_Identifier node then we
-         --  found ambiguity and could not rewrite it as N_Function_Call.
+         --  Before analyzed, a function call that has parameters is an
+         --  N_Indexed_Component node, and a call to a function that has
+         --  no parameters is an N_Identifier or an N_Expanded_Name node.
+         --  If the analysis could not rewrite it as N_Function_Call, it
+         --  indicates that ambiguity may have been encountered.
 
-         if Nkind (Str_Elem) = N_Identifier
+         elsif Nkind (Str_Elem) in N_Identifier | N_Expanded_Name
            and then Ekind (Entity (Str_Elem)) = E_Function
-           and then Is_Overloaded (Str_Elem)
          then
-            Check_Parameterless_Call (Str_Elem);
-            Check_Ambiguous_Parameterless_Call (Str_Elem);
+            Check_Ambiguous_Call (Str_Elem);
+
+         --  Report common errors
+
+         elsif Nkind (Str_Elem) = N_String_Literal then
+
+            --  No further action needed for components of the interpolated
+            --  string literal; its type will be imposed by its context when
+            --  resolved.
+
+            if Is_Interpolated_String_Literal (Str_Elem) then
+               null;
+
+            else
+               Error_Msg_N
+                 ("ambiguous string literal in interpolated expression",
+                  Str_Elem);
+               Error_Msg_N
+                 ("\\possible interpretation 'Ada.'String type!",
+                  Str_Elem);
+               Error_Msg_N
+                 ("\\possible interpretation 'Ada.'Wide_'String type!",
+                  Str_Elem);
+               Error_Msg_N
+                 ("\\possible interpretation 'Ada.'Wide_'Wide_'String"
+                  & " type!", Str_Elem);
+               Error_Msg_N
+                 ("\\must use a qualified expression", Str_Elem);
+            end if;
+
+         elsif Nkind (Str_Elem) = N_Character_Literal then
+            Error_Msg_N
+              ("ambiguous character literal in interpolated expression",
+               Str_Elem);
+            Error_Msg_N
+              ("\\possible interpretation 'Ada.'Character type!",
+               Str_Elem);
+            Error_Msg_N
+              ("\\possible interpretation 'Ada.'Wide_'Character type!",
+               Str_Elem);
+            Error_Msg_N
+              ("\\possible interpretation 'Ada.'Wide_'Wide_'Character"
+               & " type!", Str_Elem);
+            Error_Msg_N
+              ("\\must use a qualified expression", Str_Elem);
+
+         elsif Nkind (Str_Elem) in N_Integer_Literal
+                                 | N_Real_Literal
+         then
+            Error_Msg_N
+              ("ambiguous number in interpolated expression",
+               Str_Elem);
+            Error_Msg_N
+              ("\\must use a qualified expression", Str_Elem);
+
+         elsif Nkind (Str_Elem) = N_Interpolated_String_Literal then
+            Error_Msg_N ("nested interpolated string not allowed", Str_Elem);
+
+         elsif Etype (Str_Elem) in Any_Type
+                                 | Any_Array
+                                 | Any_Composite
+                                 | Any_Discrete
+                                 | Any_Fixed
+                                 | Any_Integer
+                                 | Any_Modular
+                                 | Any_Numeric
+                                 | Any_Real
+                                 | Any_String
+                                 | Universal_Integer
+                                 | Universal_Real
+                                 | Universal_Fixed
+                                 | Universal_Access
+         then
+            Error_Msg_N ("ambiguous interpolated expression", Str_Elem);
          end if;
 
          Next (Str_Elem);
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 9a3b6dd..b23ca48 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -9702,8 +9702,19 @@ package body Sem_Res is
          --  image function because under Ada 2022 all the types have such
          --  function available.
 
-         if Etype (Str_Elem) = Any_String then
+         if Nkind (Str_Elem) = N_String_Literal
+           and then Is_Interpolated_String_Literal (Str_Elem)
+         then
             Resolve (Str_Elem, Typ);
+
+         --  Must have been rejected during analysis
+
+         elsif Nkind (Str_Elem) in N_Character_Literal
+                                 | N_Integer_Literal
+                                 | N_Real_Literal
+                                 | N_String_Literal
+         then
+            pragma Assert (Error_Posted (Str_Elem));
          end if;
 
          Next (Str_Elem);
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index 95fceb5..742527f 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -1749,6 +1749,11 @@ package Sinfo is
    --    flag aids the ABE Processing phase to suppress the diagnostics of
    --    finalization actions in initialization contexts.
 
+   --  Is_Interpolated_String_Literal
+   --    Defined in string literals. Used to differentiate string literals
+   --    composed of interpolated string elements from string literals found
+   --    in interpolated expressions.
+
    --  Is_Known_Guaranteed_ABE
    --    NOTE: this flag is shared between the legacy ABE mechanism and the
    --    default ABE mechanism.
@@ -2610,6 +2615,7 @@ package Sinfo is
       --  Has_Wide_Character
       --  Has_Wide_Wide_Character
       --  Is_Folded_In_Parser
+      --  Is_Interpolated_String_Literal
       --  plus fields for expression
 
       ---------------------------------------
@@ -2617,8 +2623,7 @@ package Sinfo is
       ---------------------------------------
 
       --  INTERPOLATED_STRING_LITERAL ::=
-      --    '{' "{INTERPOLATED_STRING_ELEMENT}" {
-      --        "{INTERPOLATED_STRING_ELEMENT}" } '}'
+      --    'f' "{INTERPOLATED_STRING_ELEMENT}"
 
       --  INTERPOLATED_STRING_ELEMENT ::=
       --      ESCAPED_CHARACTER | INTERPOLATED_EXPRESSION