From c44885927186c7ab498618c0e6173d6ef0d3b633 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Wed, 12 Aug 2020 17:30:29 -0400 Subject: [PATCH] [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. --- gcc/ada/sem_ch4.adb | 2 ++ gcc/ada/sem_res.adb | 8 +++++++- gcc/ada/sem_util.adb | 21 +++++++++++++++++++++ gcc/ada/sem_util.ads | 7 +++++++ 4 files changed, 37 insertions(+), 1 deletion(-) 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; -- 2.30.2