From: Eric Botcazou <ebotca...@adacore.com> This is the clause about inferable discriminants in unchecked unions.
gcc/ada/ * sem_util.adb (Has_Inferable_Discriminants): In the case of a component with a per-object constraint, also return true if the enclosing object is not of an unchecked union type. In the default case, remove a useless call to Base_Type. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/sem_util.adb | 35 ++++++++++++++--------------------- 1 file changed, 14 insertions(+), 21 deletions(-) diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index d9ea00e53cb..736751f5fae 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -12272,33 +12272,26 @@ package body Sem_Util is begin -- For selected components, the subtype of the selector must be a -- constrained Unchecked_Union. If the component is subject to a - -- per-object constraint, then the enclosing object must have inferable - -- discriminants. + -- per-object constraint, then the enclosing object must either be + -- a regular discriminated type or must have inferable discriminants. if Nkind (N) = N_Selected_Component then - if Has_Per_Object_Constraint (Entity (Selector_Name (N))) then - - -- A small hack. If we have a per-object constrained selected - -- component of a formal parameter, return True since we do not - -- know the actual parameter association yet. - - if Prefix_Is_Formal_Parameter (N) then - return True; - - -- Otherwise, check the enclosing object and the selector - - else - return Has_Inferable_Discriminants (Prefix (N)) - and then Has_Inferable_Discriminants (Selector_Name (N)); - end if; - -- The call to Has_Inferable_Discriminants will determine whether -- the selector has a constrained Unchecked_Union nominal type. - else - return Has_Inferable_Discriminants (Selector_Name (N)); + if not Has_Inferable_Discriminants (Selector_Name (N)) then + return False; end if; + -- A small hack. If we have a per-object constrained selected + -- component of a formal parameter, return True since we do not + -- know the actual parameter association yet. + + return not Has_Per_Object_Constraint (Entity (Selector_Name (N))) + or else not Is_Unchecked_Union (Etype (Prefix (N))) + or else Has_Inferable_Discriminants (Prefix (N)) + or else Prefix_Is_Formal_Parameter (N); + -- A qualified expression has inferable discriminants if its subtype -- mark is a constrained Unchecked_Union subtype. @@ -12310,7 +12303,7 @@ package body Sem_Util is -- Unchecked_Union nominal subtype. else - return Is_Unchecked_Union (Base_Type (Etype (N))) + return Is_Unchecked_Union (Etype (N)) and then Is_Constrained (Etype (N)); end if; end Has_Inferable_Discriminants; -- 2.40.0