[Ada] Missing errors on extension aggregates with unknown discriminants
authorGary Dismukes <dismukes@adacore.com>
Thu, 10 Sep 2020 19:12:32 +0000 (15:12 -0400)
committerPierre-Marie de Rodat <derodat@adacore.com>
Mon, 26 Oct 2020 08:58:58 +0000 (04:58 -0400)
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

index fdc27b30e00ecd37a46c2d62b53ea78c3cc950ad..c75c10f9028c77b8156c64c80131a6c5896cce01 100644 (file)
@@ -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);