[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 0efe8f36204db63bc5097fd4e80b089c83419be8..30c977f4effde2161f9d54b8205e9c843cf97ca7 100644 (file)
--- 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 8b9902d07271896c4cd28658603339e2127243d2..47c743d01ef7f56adece9421bb912fbd6b1a13ff 100644 (file)
--- 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 f59df36d66b628cde7a9e8141c2193cda2b2a590..9930eb6658e1e19d9da1936051f1dd3bad36a5eb 100644 (file)
--- 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 9c7b8ca835a39d6714fe46bdbab798b8af22d34e..9030279b215ed67d956c93b2ab7be02f3dff81ad 100644 (file)
--- 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;