From: Ed Schonberg <schonberg@adacore.com>
Date: Wed, 12 Aug 2020 21:30:29 +0000 (-0400)
Subject: [Ada] AI12-0307: uniform resolution rules for aggregates
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=c44885927186c7ab498618c0e6173d6ef0d3b633;p=gcc.git

[Ada] AI12-0307: uniform resolution rules for aggregates

gcc/ada/

	* sem_util.ads, sem_util.adb (Check_Ambiguous_Aggregate): When a
	subprogram call is found to be ambiguous, check whether
	ambiguity is caused by an aggregate actual.  and indicate that
	it should carry a type qualification.
	* sem_ch4.adb (Traverse_Hoonyms, Try_Primitive_Operation): Call
	it.
	* sem_res.adb (Report_Ambiguous_Argument): Call it.
---

diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 0efe8f36204..30c977f4eff 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -9339,6 +9339,7 @@ package body Sem_Ch4 is
                         Error_Msg_NE ("ambiguous call to&", N, Hom);
                         Report_Ambiguity (Matching_Op);
                         Report_Ambiguity (Hom);
+                        Check_Ambiguous_Aggregate (New_Call_Node);
                         Error := True;
                         return;
                      end if;
@@ -9961,6 +9962,7 @@ package body Sem_Ch4 is
                      Error_Msg_NE ("ambiguous call to&", N, Prim_Op);
                      Report_Ambiguity (Matching_Op);
                      Report_Ambiguity (Prim_Op);
+                     Check_Ambiguous_Aggregate (Call_Node);
                      return True;
                   end if;
                end if;
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 8b9902d0727..47c743d01ef 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -2097,7 +2097,8 @@ package body Sem_Res is
          then
             Error_Msg_NE ("ambiguous call to&", Arg, Name (Arg));
 
-            --  Could use comments on what is going on here???
+            --  Examine possible interpretations, and adapt the message
+            --  for inherited subprograms declared by a type derivation.
 
             Get_First_Interp (Name (Arg), I, It);
             while Present (It.Nam) loop
@@ -2112,6 +2113,11 @@ package body Sem_Res is
                Get_Next_Interp (I, It);
             end loop;
          end if;
+
+         --  Additional message and hint if the ambiguity involves an Ada2020
+         --  container aggregate.
+
+         Check_Ambiguous_Aggregate (N);
       end Report_Ambiguous_Argument;
 
       -----------------------
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index f59df36d66b..9930eb6658e 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -2425,6 +2425,27 @@ package body Sem_Util is
       end if;
    end Cannot_Raise_Constraint_Error;
 
+   -------------------------------
+   -- Check_Ambiguous_Aggregate --
+   -------------------------------
+
+   procedure Check_Ambiguous_Aggregate (Call : Node_Id) is
+      Actual : Node_Id;
+
+   begin
+      if Extensions_Allowed then
+         Actual := First_Actual (Call);
+         while Present (Actual) loop
+            if Nkind (Actual) = N_Aggregate then
+               Error_Msg_N
+                 ("\add type qualification to aggregate actual", Actual);
+               exit;
+            end if;
+            Next_Actual (Actual);
+         end loop;
+      end if;
+   end Check_Ambiguous_Aggregate;
+
    -----------------------------------------
    -- Check_Dynamically_Tagged_Expression --
    -----------------------------------------
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index 9c7b8ca835a..9030279b215 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -349,6 +349,13 @@ package Sem_Util is
    --  not necessarily mean that CE could be raised, but a response of True
    --  means that for sure CE cannot be raised.
 
+   procedure Check_Ambiguous_Aggregate (Call : Node_Id);
+   --  Additional information on an ambiguous call in Ada_2020 when a
+   --  subprogram call has an actual that is an aggregate, and the
+   --  presence of container aggregates (or types with the correwponding
+   --  aspect)  provides an additional interpretation. Message indicates
+   --  that an aggregate actual should carry a type qualification.
+
    procedure Check_Dynamically_Tagged_Expression
      (Expr        : Node_Id;
       Typ         : Entity_Id;