[gcc r13-7899] ada: Improve error message for ambiguous subprogram call

[Eric Botcazou <ebotcazou@gcc.gnu.org>]

https://gcc.gnu.org/g:0bbfe1295c4d2f0387d8411a52d7a7ca5cb038ed

commit r13-7899-g0bbfe1295c4d2f0387d8411a52d7a7ca5cb038ed
Author: Eric Botcazou <ebotcazou@adacore.com>
Date:   Wed Jul 5 22:04:07 2023 +0200

    ada: Improve error message for ambiguous subprogram call
    
    This restores the full listing of the types for the interpretations.
    
    gcc/ada/
    
            * sem_util.ads (Wrong_Type): Add Multiple parameter defaulting to
            False and document it.
            * sem_util.adb (Wrong_Type): Do not return early if an error has
            already been posted on Expr and Multiple is True.
            * sem_ch4.adb (Analyze_One_Call): Pass All_Errors_Mode as the
            actual parameter for Multiple to Wrong_Type.

Diff:
---
 gcc/ada/sem_ch4.adb  |  6 +++++-
 gcc/ada/sem_util.adb | 15 ++++++++++-----
 gcc/ada/sem_util.ads |  8 ++++++--
 3 files changed, 21 insertions(+), 8 deletions(-)

diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 3df539555f2..58220bdcbf4 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -4030,7 +4030,11 @@ package body Sem_Ch4 is
                            Actual, Etype (Etype (Formal)));
                      end if;
 
-                     Wrong_Type (Actual, Etype (Formal));
+                     --  If we are going to output a secondary error message
+                     --  below, we need to have Wrong_Type output the main one.
+
+                     Wrong_Type
+                       (Actual, Etype (Formal), Multiple => All_Errors_Mode);
 
                      if Nkind (Actual) = N_Op_Eq
                        and then Nkind (Left_Opnd (Actual)) = N_Identifier
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index a77a0e8330a..4d8c7e62751 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -29397,7 +29397,11 @@ package body Sem_Util is
    -- Wrong_Type --
    ----------------
 
-   procedure Wrong_Type (Expr : Node_Id; Expected_Type : Entity_Id) is
+   procedure Wrong_Type
+     (Expr          : Node_Id;
+      Expected_Type : Entity_Id;
+      Multiple      : Boolean := False)
+   is
       Found_Type : constant Entity_Id := First_Subtype (Etype (Expr));
       Expec_Type : constant Entity_Id := First_Subtype (Expected_Type);
 
@@ -29484,13 +29488,14 @@ package body Sem_Util is
 
    begin
       --  Don't output message if either type is Any_Type, or if a message
-      --  has already been posted for this node. We need to do the latter
-      --  check explicitly (it is ordinarily done in Errout), because we
-      --  are using ! to force the output of the error messages.
+      --  has already been posted for this node and we do not want multiple
+      --  error messages. We need to do the latter check explicitly (it is
+      --  ordinarily done in Errout) because we are using '!' to force the
+      --  output of the error messages.
 
       if Expec_Type = Any_Type
         or else Found_Type = Any_Type
-        or else Error_Posted (Expr)
+        or else (Error_Posted (Expr) and then not Multiple)
       then
          return;
 
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index aa328df6fdc..130af134d16 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -3373,12 +3373,16 @@ package Sem_Util is
    --  is potentially issued: it is the visible entity in the former case, and
    --  the use_clause in the latter case.
 
-   procedure Wrong_Type (Expr : Node_Id; Expected_Type : Entity_Id);
+   procedure Wrong_Type
+     (Expr          : Node_Id;
+      Expected_Type : Entity_Id;
+      Multiple      : Boolean := False);
    --  Output error message for incorrectly typed expression. Expr is the node
    --  for the incorrectly typed construct (Etype (Expr) is the type found),
    --  and Expected_Type is the entity for the expected type. Note that Expr
    --  does not have to be a subexpression, anything with an Etype field may
-   --  be used.
+   --  be used. If Multiple is False, do not output the message if an error
+   --  has already been posted for Expr.
 
    function Yields_Synchronized_Object (Typ : Entity_Id) return Boolean;
    --  Determine whether type Typ "yields synchronized object" as specified by