diff options
author | Ed Schonberg <schonberg@adacore.com> | 2020-08-12 17:30:29 -0400 |
---|---|---|
committer | Pierre-Marie de Rodat <derodat@adacore.com> | 2020-10-22 08:11:19 -0400 |
commit | c44885927186c7ab498618c0e6173d6ef0d3b633 (patch) | |
tree | 5667ee597c6a698a50af8344645071dbd0eca186 | |
parent | 1c583927a57a06e9f94de4c982ae827d227543ab (diff) | |
download | gcc-c44885927186c7ab498618c0e6173d6ef0d3b633.zip gcc-c44885927186c7ab498618c0e6173d6ef0d3b633.tar.gz gcc-c44885927186c7ab498618c0e6173d6ef0d3b633.tar.bz2 |
[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.
-rw-r--r-- | gcc/ada/sem_ch4.adb | 2 | ||||
-rw-r--r-- | gcc/ada/sem_res.adb | 8 | ||||
-rw-r--r-- | gcc/ada/sem_util.adb | 21 | ||||
-rw-r--r-- | gcc/ada/sem_util.ads | 7 |
4 files changed, 37 insertions, 1 deletions
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 0efe8f3..30c977f 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 8b9902d..47c743d 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 f59df36..9930eb6 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 9c7b8ca..9030279 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; |