diff mbox series

[Ada] Fix PR ada/113979

Message ID 4551393.LvFx2qVVIh@localhost.localdomain
State New
Headers show
Series [Ada] Fix PR ada/113979 | expand

Commit Message

Eric Botcazou March 7, 2024, 2:27 p.m. UTC 
This is a regression present on all active branches: the compiler gives a 
bogus error on an allocator for an unconstrained array type declared with a 
Dynamic_Predicate because Apply_Predicate_Check is invoked directly on a 
subtype reference, which it cannot handle.

This moves the check to the resulting access value (after dereference) like in 
Expand_Allocator_Expression.

Tested on x86-64/Linux, applied on all active branches.


2024-03-07  Eric Botcazou  <ebotcazou@adacore.com>

	PR ada/113979
	* exp_ch4.adb (Expand_N_Allocator): In the subtype indication case,
	call Apply_Predicate_Check on the resulting access value if needed.


2024-03-07  Eric Botcazou  <ebotcazou@adacore.com>

	* testsuite/gnat.dg/predicate15.adb: New test.
diff mbox series

Patch

diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 4f83cd4737a..e4a40414872 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -4657,8 +4657,6 @@  package body Exp_Ch4 is
          if Is_Array_Type (Dtyp) and then not No_Initialization (N) then
             Apply_Constraint_Check (Expression (N), Dtyp, No_Sliding => True);
 
-            Apply_Predicate_Check (Expression (N), Dtyp);
-
             if Nkind (Expression (N)) = N_Raise_Constraint_Error then
                Rewrite (N, New_Copy (Expression (N)));
                Set_Etype (N, PtrT);
@@ -4752,6 +4750,8 @@  package body Exp_Ch4 is
             Rewrite (N, New_Occurrence_Of (Temp, Loc));
             Analyze_And_Resolve (N, PtrT);
 
+            Apply_Predicate_Check (N, Dtyp, Deref => True);
+
          --  Case of no initialization procedure present
 
          elsif not Has_Non_Null_Base_Init_Proc (T) then
@@ -5119,6 +5119,8 @@  package body Exp_Ch4 is
                Rewrite (N, New_Occurrence_Of (Temp, Loc));
                Analyze_And_Resolve (N, PtrT);
 
+               Apply_Predicate_Check (N, Dtyp, Deref => True);
+
                --  When designated type has Default_Initial_Condition aspects,
                --  make a call to the type's DIC procedure to perform the
                --  checks. Theoretically this might also be needed for cases