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 --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index 55a81d90045c9c05ef7acd7abaf59cee44262ec7..3a0f86fc7f2cea6354c6e5eaaf011a7dc2fdc4c5 100644 (file)
--- 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 453ed4850be66cc4faaa94a44024a4e905ff32fb..f9bd98a9e45e7981c5eb9252452abf8fdf102185 100644 (file)
--- 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 bce854fddb73e44a94b58e3e83d530a137b40124..00f8aec87b3a15c0858e35ce75edbd341e61563c 100644 (file)
--- 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 =>