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.
Tested on x86-64/Linux, applied on the mainline.
2026-02-03 Eric Botcazou <[email protected]>
* 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.
--
Eric Botcazoudiff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index 55a81d90045..3a0f86fc7f2 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 453ed4850be..f9bd98a9e45 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 bce854fddb7..00f8aec87b3 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 =>
