diff options
author | Eric Botcazou <ebotcazou@adacore.com> | 2023-06-20 19:46:43 +0200 |
---|---|---|
committer | Marc Poulhiès <poulhies@adacore.com> | 2023-07-03 15:26:13 +0200 |
commit | a7a89c370c0ac78fb08eec49cb08b1a23cc4c8b7 (patch) | |
tree | 6b910c5d3df131dcee1508e46f899836437d2555 | |
parent | b0762d4c7e7894845e70e839c8513ae4c9e9d42e (diff) | |
download | gcc-a7a89c370c0ac78fb08eec49cb08b1a23cc4c8b7.zip gcc-a7a89c370c0ac78fb08eec49cb08b1a23cc4c8b7.tar.gz gcc-a7a89c370c0ac78fb08eec49cb08b1a23cc4c8b7.tar.bz2 |
ada: Fix small inaccuracy in implementation of B.3.3(20/2)
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.
-rw-r--r-- | gcc/ada/sem_util.adb | 35 |
1 files changed, 14 insertions, 21 deletions
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index d9ea00e..736751f 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; |