https://gcc.gnu.org/g:bb4791c336e5f5c6be707a6219b128da0a0a184b
commit r16-7252-gbb4791c336e5f5c6be707a6219b128da0a0a184b Author: Eric Botcazou <[email protected]> Date: Tue Feb 3 08:45:23 2026 +0100 Ada: Fix couple of small accessibility glitches The first glitch is that the ACATS test c3a0025 does not pass in Ada 2005 because an accessibility check preempts a null access check. The second glitch is that there should be no differences in Ada 2012 and later for the test, in other words there is a missing accessibility check failure. The second glitch comes from a thinko in the new implementation of the In_Return_Value predicate, which has incorrectly dropped the handling of assignments to return objects. The first glitch is fixed by swapping the order of null access checks and accessibility checks for conversions, which requires adding a small guard to Apply_Discriminant_Check. gcc/ada/ * checks.adb (Apply_Discriminant_Check): Bail out for a source type that is a class-wide type whose root type has no discriminants. * exp_ch4.adb (Expand_N_Type_Conversion): If the target type is an access type, emit null access checks before accessibility checks. * sem_util.adb (In_Return_Value): Deal again with assignments to return objects. Diff: --- gcc/ada/checks.adb | 8 ++++++-- gcc/ada/exp_ch4.adb | 11 +++++------ gcc/ada/sem_util.adb | 7 +++++++ 3 files changed, 18 insertions(+), 8 deletions(-) diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 55a81d90045c..3a0f86fc7f2c 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -1533,7 +1533,8 @@ package body Checks is -- Also, if the expression is of an access type whose designated type is -- incomplete, then the access value must be null and we suppress the - -- check. + -- check. We also need to suppress it for a class-wide type whose root + -- type has no discriminants. if Known_Null (N) then return; @@ -1541,7 +1542,10 @@ package body Checks is elsif Is_Access_Type (S_Typ) then S_Typ := Designated_Type (S_Typ); - if Ekind (S_Typ) = E_Incomplete_Type then + if Ekind (S_Typ) = E_Incomplete_Type + or else (Is_Class_Wide_Type (S_Typ) + and then not Has_Discriminants (Root_Type (S_Typ))) + then return; end if; end if; diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 453ed4850be6..f9bd98a9e45e 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -12325,6 +12325,10 @@ package body Exp_Ch4 is -- Case of converting to an access type if Is_Access_Type (Target_Type) then + -- Generate a null access check first for the sake of ACATS c3a0025 + + Apply_Constraint_Check (Operand, Target_Type); + -- In terms of accessibility rules, an anonymous access discriminant -- is not considered separate from its parent object. @@ -12447,7 +12451,7 @@ package body Exp_Ch4 is -- Case of conversions of tagged types and access to tagged types - -- When needed, that is to say when the expression is class-wide, Add + -- When needed, that is to say when the expression is class-wide, add -- runtime a tag check for (strict) downward conversion by using the -- membership test, generating: @@ -12580,11 +12584,6 @@ package body Exp_Ch4 is end if; end Tagged_Conversion; - -- Case of other access type conversions - - elsif Is_Access_Type (Target_Type) then - Apply_Constraint_Check (Operand, Target_Type); - -- Case of conversions from a fixed-point type -- These conversions require special expansion and processing, found in diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index bce854fddb73..00f8aec87b3a 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -14791,6 +14791,13 @@ package body Sem_Util is return Is_Return_Object (Defining_Identifier (P)) and then Exp_Defines_Or_Is_Tied_To_Return_Value; + -- Something assigned to a return object is a return value + + when N_Assignment_Statement => + return Is_Entity_Name (Name (P)) + and then Is_Return_Object (Entity (Name (P))) + and then Exp_Defines_Or_Is_Tied_To_Return_Value; + -- An allocator is not a return value unless specially built when N_Allocator =>
