diff options
| author | Eric Botcazou <ebotcazou@adacore.com> | 2024-03-07 15:05:54 +0100 |
|---|---|---|
| committer | Eric Botcazou <ebotcazou@adacore.com> | 2024-03-07 15:08:28 +0100 |
| commit | e71a4e81729516eed8782a255ff37617e6fd4b69 (patch) | |
| tree | a6742d6e025673ab2d40abe584e7b4f788ba516e /gcc | |
| parent | 9970b576b7e4ae337af1268395ff221348c4b34a (diff) | |
| download | gcc-e71a4e81729516eed8782a255ff37617e6fd4b69.zip gcc-e71a4e81729516eed8782a255ff37617e6fd4b69.tar.gz gcc-e71a4e81729516eed8782a255ff37617e6fd4b69.tar.bz2 | |
Fix bogus error on allocator for array type with Dynamic_Predicate
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.
gcc/ada/
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.
gcc/testsuite/
* gnat.dg/predicate15.adb: New test.
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/exp_ch4.adb | 6 | ||||
| -rw-r--r-- | gcc/testsuite/gnat.dg/predicate15.adb | 15 |
2 files changed, 19 insertions, 2 deletions
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 4f83cd4..e4a4041 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 diff --git a/gcc/testsuite/gnat.dg/predicate15.adb b/gcc/testsuite/gnat.dg/predicate15.adb new file mode 100644 index 0000000..cf9e1d9 --- /dev/null +++ b/gcc/testsuite/gnat.dg/predicate15.adb @@ -0,0 +1,15 @@ +-- { dg-do compile } +-- { dg-options "-gnata" } + +procedure Predicate15 is + + type Grid is array (Positive range <>) of Integer with + Dynamic_Predicate => Grid'First = 1; + + type Grid_Ptr is access Grid; + + Data : Grid_Ptr := new Grid (1 .. 10); + +begin + null; +end; |