From 5c6430d68c3d53a191c2be934ee17aebde50e908 Mon Sep 17 00:00:00 2001 From: Gary Dismukes Date: Thu, 10 Sep 2020 15:12:32 -0400 Subject: [PATCH] [Ada] Missing errors on extension aggregates with unknown discriminants gcc/ada/ * sem_aggr.adb (Resolve_Extension_Aggregate): When testing for an aggregate that is illegal due to having an ancestor type that has unknown discriminants, add an "or else" condition testing whether the aggregate type has unknown discriminants and that Partial_View_Has_Unknown_Discr is also set on the ancestor type. Extend the comment, including adding ??? about a possible simpler test. --- gcc/ada/sem_aggr.adb | 21 +++++++++++++++++---- 1 file changed, 17 insertions(+), 4 deletions(-) diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index fdc27b30e00..c75c10f9028 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -3458,10 +3458,23 @@ package body Sem_Aggr is if Is_Entity_Name (A) and then Is_Type (Entity (A)) then - -- AI05-0115: if the ancestor part is a subtype mark, the ancestor - -- must not have unknown discriminants. - - if Has_Unknown_Discriminants (Entity (A)) then + -- AI05-0115: If the ancestor part is a subtype mark, the ancestor + -- must not have unknown discriminants. To catch cases where the + -- aggregate occurs at a place where the full view of the ancestor + -- type is visible and doesn't have unknown discriminants, but the + -- aggregate type was derived from a partial view that has unknown + -- discriminants, we check whether the aggregate type has unknown + -- discriminants (unknown discriminants were inherited), along + -- with checking that the partial view of the ancestor has unknown + -- discriminants. (It might be sufficient to replace the entire + -- condition with Has_Unknown_Discriminants (Typ), but that might + -- miss some cases, not clear, and causes error changes in some tests + -- such as class-wide cases, that aren't clearly improvements. ???) + + if Has_Unknown_Discriminants (Entity (A)) + or else (Has_Unknown_Discriminants (Typ) + and then Partial_View_Has_Unknown_Discr (Entity (A))) + then Error_Msg_NE ("aggregate not available for type& whose ancestor " & "has unknown discriminants", N, Typ); -- 2.30.2